* [PATCH] Automatics in equivalence statements
@ 2019-06-21 13:31 Mark Eggleston
2019-06-21 14:10 ` Steve Kargl
0 siblings, 1 reply; 10+ messages in thread
From: Mark Eggleston @ 2019-06-21 13:31 UTC (permalink / raw)
To: fortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 2021 bytes --]
Currently variables with the AUTOMATIC attribute can not appear in an
EQUIVALENCE statement. However its counterpart, STATIC, can be used in
an EQUIVALENCE statement.
Where there is a clear conflict in the attributes of variables in an
EQUIVALENCE statement an error message will be issued as is currently
the case.
If there is no conflict e.g. a variable with a AUTOMATIC attribute and a
variable(s) without attributes all variables in the EQUIVALENCE will
become AUTOMATIC.
Note: most of this patch was written by Jeff Law <law@redhat.com>
Please review.
ChangeLogs:
gcc/fortran
   Jeff Law <law@redhat.com>
   Mark Eggleston <mark.eggleston@codethink.com>
   * gfortran.h: Add check_conflict declaration.
   * symbol.c (check_conflict): Remove automatic in equivalence conflict
   check.
   * symbol.c (save_symbol): Add check for in equivalence to stop the
   the save attribute being added.
   * trans-common.c (build_equiv_decl): Add is_auto parameter and
   add !is_auto to condition where TREE_STATIC (decl) is set.
   * trans-common.c (build_equiv_decl): Add local variable is_auto,
   set it true if an atomatic attribute is encountered in the variable
   list. Call build_equiv_decl with is_auto as an additional parameter.
   flag_dec_format_defaults is enabled.
   * trans-common.c (accumulate_equivalence_attributes) : New subroutine.
   * trans-common.c (find_equivalence) : New local variable dummy_symbol,
   accumulated equivalence attributes from each symbol then check for
   conflicts.
gcc/testsuite
   Mark Eggleston <mark.eggleston@codethink.com>
   * gfortran.dg/auto_in_equiv_1.f90: New test.
   * gfortran.dg/auto_in_equiv_2.f90: New test.
   * gfortran.dg/auto_in_equiv_3.f90: New test.
--
https://www.codethink.co.uk/privacy.html
[-- Attachment #2: 0005-Allow-automatics-in-equivalence.patch --]
[-- Type: text/x-patch, Size: 12008 bytes --]
From 5c26e610e6d21c04f7a175804829ee5187e25ff2 Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggleston@codethink.com>
Date: Tue, 11 Sep 2018 12:50:11 +0100
Subject: [PATCH 5/9] Allow automatics in equivalence
If a variable with an automatic attribute appears in an
equivalence statement the storage should be allocated on
the stack.
Note: most of this patch was provided by Jeff Law <law@redhat.com>.
---
gcc/fortran/gfortran.h | 1 +
gcc/fortran/symbol.c | 4 +-
gcc/fortran/trans-common.c | 75 +++++++++++++++++++++++++--
gcc/testsuite/gfortran.dg/auto_in_equiv_1.f90 | 36 +++++++++++++
gcc/testsuite/gfortran.dg/auto_in_equiv_2.f90 | 38 ++++++++++++++
gcc/testsuite/gfortran.dg/auto_in_equiv_3.f90 | 63 ++++++++++++++++++++++
6 files changed, 210 insertions(+), 7 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/auto_in_equiv_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/auto_in_equiv_2.f90
create mode 100644 gcc/testsuite/gfortran.dg/auto_in_equiv_3.f90
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index b1f7bd0604a..9b3f17fe750 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2996,6 +2996,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 ec753229a98..316173c62d0 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -407,7 +407,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",
@@ -544,7 +544,6 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf (allocatable, elemental);
conf (in_common, automatic);
- conf (in_equivalence, automatic);
conf (result, automatic);
conf (use_assoc, automatic);
conf (dummy, automatic);
@@ -4244,6 +4243,7 @@ save_symbol (gfc_symbol *sym)
return;
if (sym->attr.in_common
+ || sym->attr.in_equivalence
|| sym->attr.dummy
|| sym->attr.result
|| sym->attr.flavor != FL_VARIABLE)
diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index debdbd98ac0..a5fb230bb1b 100644
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -339,7 +339,7 @@ build_field (segment_info *h, tree union_type, record_layout_info rli)
/* 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 @@ build_equiv_decl (tree union_type, bool is_init, bool is_saved)
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;
@@ -611,6 +611,7 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
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 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
/* 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 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
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)
{
@@ -948,6 +953,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. */
@@ -965,9 +1025,12 @@ find_equivalence (segment_info *n)
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 +1038,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 --git a/gcc/testsuite/gfortran.dg/auto_in_equiv_1.f90 b/gcc/testsuite/gfortran.dg/auto_in_equiv_1.f90
new file mode 100644
index 00000000000..61bfd0738c5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_in_equiv_1.f90
@@ -0,0 +1,36 @@
+! { dg-compile }
+
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+program test
+ call suba(0)
+ call subb(0)
+ call suba(1)
+
+contains
+ subroutine suba(option)
+ integer, intent(in) :: option
+ integer, automatic :: a ! { dg-error "AUTOMATIC at \\(1\\) is a DEC extension" }
+ integer :: b
+ integer :: c
+ equivalence (a, b)
+ if (option.eq.0) then
+ ! initialise a and c
+ a = 9
+ c = 99
+ if (a.ne.b) stop 1
+ if (loc(a).ne.loc(b)) stop 2
+ else
+ ! a should've been overwritten
+ if (a.eq.9) stop 3
+ end if
+ end subroutine suba
+
+ subroutine subb(dummy)
+ integer, intent(in) :: dummy
+ integer, automatic :: x ! { dg-error "AUTOMATIC at \\(1\\) is a DEC extension" }
+ integer :: y
+ x = 77
+ y = 7
+ end subroutine subb
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/auto_in_equiv_2.f90 b/gcc/testsuite/gfortran.dg/auto_in_equiv_2.f90
new file mode 100644
index 00000000000..406e718604a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_in_equiv_2.f90
@@ -0,0 +1,38 @@
+! { dg-run }
+! { dg-options "-fdec-static" }
+
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+
+program test
+ call suba(0)
+ call subb(0)
+ call suba(1)
+
+contains
+ subroutine suba(option)
+ integer, intent(in) :: option
+ integer, automatic :: a
+ integer :: b
+ integer :: c
+ equivalence (a, b)
+ if (option.eq.0) then
+ ! initialise a and c
+ a = 9
+ c = 99
+ if (a.ne.b) stop 1
+ if (loc(a).ne.loc(b)) stop 2
+ else
+ ! a should've been overwritten
+ if (a.eq.9) stop 3
+ end if
+ end subroutine suba
+
+ subroutine subb(dummy)
+ integer, intent(in) :: dummy
+ integer, automatic :: x
+ integer :: y
+ x = 77
+ y = 7
+ end subroutine subb
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/auto_in_equiv_3.f90 b/gcc/testsuite/gfortran.dg/auto_in_equiv_3.f90
new file mode 100644
index 00000000000..c67aa8c6ac1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_in_equiv_3.f90
@@ -0,0 +1,63 @@
+! { dg-run }
+! { dg-options "-fdec-static -fno-automatic" }
+
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+
+! Storage is NOT on the static unless explicitly specified using the
+! DEC extension "automatic". The address of the first local variable
+! is used to determine that storage for the automatic local variable
+! is different to that of a local variable with no attributes. The
+! contents of the local variable in suba should be overwritten by the
+! call to subb.
+!
+program test
+ integer :: dummy
+ integer, parameter :: address = kind(loc(dummy))
+ integer(address) :: ad1
+ integer(address) :: ad2
+ integer(address) :: ad3
+ logical :: ok
+
+ call suba(0, ad1)
+ call subb(0, ad2)
+ call suba(1, ad1)
+ call subc(0, ad3)
+ ok = (ad1.eq.ad3).and.(ad1.ne.ad2)
+ if (.not.ok) stop 4
+
+contains
+ subroutine suba(option, addr)
+ integer, intent(in) :: option
+ integer(address), intent(out) :: addr
+ integer, automatic :: a
+ integer :: b
+ equivalence (a, b)
+ addr = loc(a)
+ if (option.eq.0) then
+ ! initialise a and c
+ a = 9
+ if (a.ne.b) stop 1
+ if (loc(a).ne.loc(b)) stop 2
+ else
+ ! a should've been overwritten
+ if (a.eq.9) stop 3
+ end if
+ end subroutine suba
+
+ subroutine subb(dummy, addr)
+ integer, intent(in) :: dummy
+ integer(address), intent(out) :: addr
+ integer :: x
+ addr = loc(x)
+ x = 77
+ end subroutine subb
+
+ subroutine subc(dummy, addr)
+ integer, intent(in) :: dummy
+ integer(address), intent(out) :: addr
+ integer, automatic :: y
+ addr = loc(y)
+ y = 77
+ end subroutine subc
+
+end program test
--
2.11.0
^ permalink raw reply [flat|nested] 10+ messages in thread
* Re: [PATCH] Automatics in equivalence statements
2019-06-21 13:31 [PATCH] Automatics in equivalence statements Mark Eggleston
@ 2019-06-21 14:10 ` Steve Kargl
2019-06-24 8:19 ` Bernhard Reutner-Fischer
0 siblings, 1 reply; 10+ messages in thread
From: Steve Kargl @ 2019-06-21 14:10 UTC (permalink / raw)
To: Mark Eggleston; +Cc: fortran, gcc-patches
On Fri, Jun 21, 2019 at 02:31:51PM +0100, Mark Eggleston wrote:
> Currently variables with the AUTOMATIC attribute can not appear in an
> EQUIVALENCE statement. However its counterpart, STATIC, can be used in
> an EQUIVALENCE statement.
>
> Where there is a clear conflict in the attributes of variables in an
> EQUIVALENCE statement an error message will be issued as is currently
> the case.
>
> If there is no conflict e.g. a variable with a AUTOMATIC attribute and a
> variable(s) without attributes all variables in the EQUIVALENCE will
> become AUTOMATIC.
>
> Note: most of this patch was written by Jeff Law <law@redhat.com>
>
> Please review.
>
> ChangeLogs:
>
> gcc/fortran
>
>    Jeff Law <law@redhat.com>
>    Mark Eggleston <mark.eggleston@codethink.com>
>
> Â Â Â * gfortran.h: Add check_conflict declaration.
This is wrong. By convention a routine that is not static
has the gfc_ prefix.
--
Steve
20170425 https://www.youtube.com/watch?v=VWUpyCsUKR4
20161221 https://www.youtube.com/watch?v=IbCHE-hONow
^ permalink raw reply [flat|nested] 10+ messages in thread
* Re: [PATCH] Automatics in equivalence statements
2019-06-21 14:10 ` Steve Kargl
@ 2019-06-24 8:19 ` Bernhard Reutner-Fischer
2019-06-24 13:47 ` Mark Eggleston
2019-06-24 23:18 ` Jeff Law
0 siblings, 2 replies; 10+ messages in thread
From: Bernhard Reutner-Fischer @ 2019-06-24 8:19 UTC (permalink / raw)
To: Steve Kargl
Cc: Mark Eggleston, fortran, gcc-patches, Bernhard Reutner-Fischer
On Fri, 21 Jun 2019 07:10:11 -0700
Steve Kargl <sgk@troutmask.apl.washington.edu> wrote:
> On Fri, Jun 21, 2019 at 02:31:51PM +0100, Mark Eggleston wrote:
> > Currently variables with the AUTOMATIC attribute can not appear in an
> > EQUIVALENCE statement. However its counterpart, STATIC, can be used in
> > an EQUIVALENCE statement.
> >
> > Where there is a clear conflict in the attributes of variables in an
> > EQUIVALENCE statement an error message will be issued as is currently
> > the case.
> >
> > If there is no conflict e.g. a variable with a AUTOMATIC attribute and a
> > variable(s) without attributes all variables in the EQUIVALENCE will
> > become AUTOMATIC.
> >
> > Note: most of this patch was written by Jeff Law <law@redhat.com>
> >
> > Please review.
> >
> > ChangeLogs:
> >
> > gcc/fortran
> >
> > Jeff Law <law@redhat.com>
> > Mark Eggleston <mark.eggleston@codethink.com>
> >
> > * gfortran.h: Add check_conflict declaration.
>
> This is wrong. By convention a routine that is not static
> has the gfc_ prefix.
>
Furthermore doesn't this export indicate that you're committing a
layering violation somehow?
> * symbol.c (check_conflict): Remove automatic in equivalence conflict
> check.
> * symbol.c (save_symbol): Add check for in equivalence to stop the
> the save attribute being added.
> * trans-common.c (build_equiv_decl): Add is_auto parameter and
> add !is_auto to condition where TREE_STATIC (decl) is set.
> * trans-common.c (build_equiv_decl): Add local variable is_auto,
> set it true if an atomatic attribute is encountered in the variable
atomatic? I read atomic but you mean automatic.
> list. Call build_equiv_decl with is_auto as an additional parameter.
> flag_dec_format_defaults is enabled.
> * trans-common.c (accumulate_equivalence_attributes) : New subroutine.
> * trans-common.c (find_equivalence) : New local variable dummy_symbol,
> accumulated equivalence attributes from each symbol then check for
> conflicts.
I'm just curious why you don't gfc_copy_attr for the most part of accumulate_equivalence_attributes?
thanks,
^ permalink raw reply [flat|nested] 10+ messages in thread
* Re: [PATCH] Automatics in equivalence statements
2019-06-24 8:19 ` Bernhard Reutner-Fischer
@ 2019-06-24 13:47 ` Mark Eggleston
2019-06-24 23:18 ` Jeff Law
1 sibling, 0 replies; 10+ messages in thread
From: Mark Eggleston @ 2019-06-24 13:47 UTC (permalink / raw)
To: Bernhard Reutner-Fischer, Steve Kargl; +Cc: fortran, gcc-patches
On 24/06/2019 09:19, Bernhard Reutner-Fischer wrote:
> On Fri, 21 Jun 2019 07:10:11 -0700
> Steve Kargl <sgk@troutmask.apl.washington.edu> wrote:
>
>> On Fri, Jun 21, 2019 at 02:31:51PM +0100, Mark Eggleston wrote:
>>> Currently variables with the AUTOMATIC attribute can not appear in an
>>> EQUIVALENCE statement. However its counterpart, STATIC, can be used in
>>> an EQUIVALENCE statement.
>>>
>>> Where there is a clear conflict in the attributes of variables in an
>>> EQUIVALENCE statement an error message will be issued as is currently
>>> the case.
>>>
>>> If there is no conflict e.g. a variable with a AUTOMATIC attribute and a
>>> variable(s) without attributes all variables in the EQUIVALENCE will
>>> become AUTOMATIC.
>>>
>>> Note: most of this patch was written by Jeff Law <law@redhat.com>
>>>
>>> Please review.
>>>
>>> ChangeLogs:
>>>
>>> gcc/fortran
>>>
>>>    Jeff Law <law@redhat.com>
>>>    Mark Eggleston <mark.eggleston@codethink.com>
>>>
>>> Â Â Â * gfortran.h: Add check_conflict declaration.
>> This is wrong. By convention a routine that is not static
>> has the gfc_ prefix.
>>
> Furthermore doesn't this export indicate that you're committing a
> layering violation somehow?
Don't know what this means.
>
>> Â Â Â * symbol.c (check_conflict): Remove automatic in equivalence conflict
>> Â Â Â check.
>> Â Â Â * symbol.c (save_symbol): Add check for in equivalence to stop the
>> Â Â Â the save attribute being added.
>> Â Â Â * trans-common.c (build_equiv_decl): Add is_auto parameter and
>> Â Â Â add !is_auto to condition where TREE_STATIC (decl) is set.
>> Â Â Â * trans-common.c (build_equiv_decl): Add local variable is_auto,
>> Â Â Â set it true if an atomatic attribute is encountered in the variable
> atomatic? I read atomic but you mean automatic.
>
>>    list. Call build_equiv_decl with is_auto as an additional parameter.
>> Â Â Â flag_dec_format_defaults is enabled.
>> Â Â Â * trans-common.c (accumulate_equivalence_attributes) : New subroutine.
>> Â Â Â * trans-common.c (find_equivalence) : New local variable dummy_symbol,
>> Â Â Â accumulated equivalence attributes from each symbol then check for
>> Â Â Â conflicts.
> I'm just curious why you don't gfc_copy_attr for the most part of accumulate_equivalence_attributes?
> thanks,
I didn't write the original of this patch, I made a minor change and
wrote the test cases. The main body of the work was done by Jeff LawÂ
<law@redhat.com>. I'll have a look at gfc_copy_attr to see if better
code can be used.
I have inherited the responsibility of getting this patch upstreamed,
any help in achieving this will be appreciated.
Mark
--
https://www.codethink.co.uk/privacy.html
^ permalink raw reply [flat|nested] 10+ messages in thread
* Re: [PATCH] Automatics in equivalence statements
2019-06-24 8:19 ` Bernhard Reutner-Fischer
2019-06-24 13:47 ` Mark Eggleston
@ 2019-06-24 23:18 ` Jeff Law
2019-06-25 13:17 ` Mark Eggleston
1 sibling, 1 reply; 10+ messages in thread
From: Jeff Law @ 2019-06-24 23:18 UTC (permalink / raw)
To: Bernhard Reutner-Fischer, Steve Kargl
Cc: Mark Eggleston, fortran, gcc-patches
On 6/24/19 2:19 AM, Bernhard Reutner-Fischer wrote:
> On Fri, 21 Jun 2019 07:10:11 -0700
> Steve Kargl <sgk@troutmask.apl.washington.edu> wrote:
>
>> On Fri, Jun 21, 2019 at 02:31:51PM +0100, Mark Eggleston wrote:
>>> Currently variables with the AUTOMATIC attribute can not appear in an
>>> EQUIVALENCE statement. However its counterpart, STATIC, can be used in
>>> an EQUIVALENCE statement.
>>>
>>> Where there is a clear conflict in the attributes of variables in an
>>> EQUIVALENCE statement an error message will be issued as is currently
>>> the case.
>>>
>>> If there is no conflict e.g. a variable with a AUTOMATIC attribute and a
>>> variable(s) without attributes all variables in the EQUIVALENCE will
>>> become AUTOMATIC.
>>>
>>> Note: most of this patch was written by Jeff Law <law@redhat.com>
>>>
>>> Please review.
>>>
>>> ChangeLogs:
>>>
>>> gcc/fortran
>>>
>>>    Jeff Law <law@redhat.com>
>>>    Mark Eggleston <mark.eggleston@codethink.com>
>>>
>>> Â Â Â * gfortran.h: Add check_conflict declaration.
>>
>> This is wrong. By convention a routine that is not static
>> has the gfc_ prefix.
>>
> Furthermore doesn't this export indicate that you're committing a
> layering violation somehow?
Possibly. I'm the original author, but my experience in our fortran
front-end is minimal. I fully expected this patch to need some tweaking.
We certainly don't want to recreate all the checking that's done in
check_conflict. We just need to defer it to a later point --
find_equivalence seemed like a good point since we've got the full
equivalence list handy and can accumulate the attributes across the
entire list, then check for conflicts.
If there's a concrete place where you think we should be doing this, I'm
all ears.
>
>> Â Â Â * symbol.c (check_conflict): Remove automatic in equivalence conflict
>> Â Â Â check.
>> Â Â Â * symbol.c (save_symbol): Add check for in equivalence to stop the
>> Â Â Â the save attribute being added.
>> Â Â Â * trans-common.c (build_equiv_decl): Add is_auto parameter and
>> Â Â Â add !is_auto to condition where TREE_STATIC (decl) is set.
>> Â Â Â * trans-common.c (build_equiv_decl): Add local variable is_auto,
>> Â Â Â set it true if an atomatic attribute is encountered in the variable
>
> atomatic? I read atomic but you mean automatic.
Yes.
>
>>    list. Call build_equiv_decl with is_auto as an additional parameter.
>> Â Â Â flag_dec_format_defaults is enabled.
>> Â Â Â * trans-common.c (accumulate_equivalence_attributes) : New subroutine.
>> Â Â Â * trans-common.c (find_equivalence) : New local variable dummy_symbol,
>> Â Â Â accumulated equivalence attributes from each symbol then check for
>> Â Â Â conflicts.
>
> I'm just curious why you don't gfc_copy_attr for the most part of accumulate_equivalence_attributes?
> thanks,
Simply didn't know about it. It could probably significantly simplify
the accumulation of attributes step.
Jeff
^ permalink raw reply [flat|nested] 10+ messages in thread
* Re: [PATCH] Automatics in equivalence statements
2019-06-24 23:18 ` Jeff Law
@ 2019-06-25 13:17 ` Mark Eggleston
2019-07-01 9:35 ` Mark Eggleston
0 siblings, 1 reply; 10+ messages in thread
From: Mark Eggleston @ 2019-06-25 13:17 UTC (permalink / raw)
To: Jeff Law, Bernhard Reutner-Fischer, Steve Kargl; +Cc: fortran, gcc-patches
On 25/06/2019 00:17, Jeff Law wrote:
> On 6/24/19 2:19 AM, Bernhard Reutner-Fischer wrote:
>> On Fri, 21 Jun 2019 07:10:11 -0700
>> Steve Kargl <sgk@troutmask.apl.washington.edu> wrote:
>>
>>> On Fri, Jun 21, 2019 at 02:31:51PM +0100, Mark Eggleston wrote:
>>>> Currently variables with the AUTOMATIC attribute can not appear in an
>>>> EQUIVALENCE statement. However its counterpart, STATIC, can be used in
>>>> an EQUIVALENCE statement.
>>>>
>>>> Where there is a clear conflict in the attributes of variables in an
>>>> EQUIVALENCE statement an error message will be issued as is currently
>>>> the case.
>>>>
>>>> If there is no conflict e.g. a variable with a AUTOMATIC attribute and a
>>>> variable(s) without attributes all variables in the EQUIVALENCE will
>>>> become AUTOMATIC.
>>>>
>>>> Note: most of this patch was written by Jeff Law <law@redhat.com>
>>>>
>>>> Please review.
>>>>
>>>> ChangeLogs:
>>>>
>>>> gcc/fortran
>>>>
>>>>    Jeff Law <law@redhat.com>
>>>>    Mark Eggleston <mark.eggleston@codethink.com>
>>>>
>>>> Â Â Â * gfortran.h: Add check_conflict declaration.
>>> This is wrong. By convention a routine that is not static
>>> has the gfc_ prefix.
>>>
>> Furthermore doesn't this export indicate that you're committing a
>> layering violation somehow?
> Possibly. I'm the original author, but my experience in our fortran
> front-end is minimal. I fully expected this patch to need some tweaking.
>
> We certainly don't want to recreate all the checking that's done in
> check_conflict. We just need to defer it to a later point --
> find_equivalence seemed like a good point since we've got the full
> equivalence list handy and can accumulate the attributes across the
> entire list, then check for conflicts.
>
> If there's a concrete place where you think we should be doing this, I'm
> all ears.
>
Any suggestions will be appreciate.
>>> Â Â Â * symbol.c (check_conflict): Remove automatic in equivalence conflict
>>> Â Â Â check.
>>> Â Â Â * symbol.c (save_symbol): Add check for in equivalence to stop the
>>> Â Â Â the save attribute being added.
>>> Â Â Â * trans-common.c (build_equiv_decl): Add is_auto parameter and
>>> Â Â Â add !is_auto to condition where TREE_STATIC (decl) is set.
>>> Â Â Â * trans-common.c (build_equiv_decl): Add local variable is_auto,
>>> Â Â Â set it true if an atomatic attribute is encountered in the variable
>> atomatic? I read atomic but you mean automatic.
> Yes.
>
>>>    list. Call build_equiv_decl with is_auto as an additional parameter.
>>> Â Â Â flag_dec_format_defaults is enabled.
>>> Â Â Â * trans-common.c (accumulate_equivalence_attributes) : New subroutine.
>>> Â Â Â * trans-common.c (find_equivalence) : New local variable dummy_symbol,
>>> Â Â Â accumulated equivalence attributes from each symbol then check for
>>> Â Â Â conflicts.
>> I'm just curious why you don't gfc_copy_attr for the most part of accumulate_equivalence_attributes?
>> thanks,
> Simply didn't know about it. It could probably significantly simplify
> the accumulation of attributes step.
Using gfc_copy_attr causes a great many "Duplicate DIMENSION attribute
specified at (1)" errors. This is because there is a great deal of
checking done instead of simply keeping track of the attributes used
which is all that is required for determining whether there is a
conflict in the equivalence statement.
Also, the final section of accumulate_equivalence_attributes involving
SAVE, INTENT and ACCESS look suspect to me. I'll check and update the
patch if necessary.
> Jeff
>
>
>
--
https://www.codethink.co.uk/privacy.html
^ permalink raw reply [flat|nested] 10+ messages in thread
* Re: [PATCH] Automatics in equivalence statements
2019-06-25 13:17 ` Mark Eggleston
@ 2019-07-01 9:35 ` Mark Eggleston
2019-07-08 13:51 ` **ping** " Mark Eggleston
2019-07-23 0:23 ` Jeff Law
0 siblings, 2 replies; 10+ messages in thread
From: Mark Eggleston @ 2019-07-01 9:35 UTC (permalink / raw)
To: Jeff Law, Bernhard Reutner-Fischer, Steve Kargl; +Cc: fortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 5865 bytes --]
On 25/06/2019 14:17, Mark Eggleston wrote:
>
> On 25/06/2019 00:17, Jeff Law wrote:
>> On 6/24/19 2:19 AM, Bernhard Reutner-Fischer wrote:
>>> On Fri, 21 Jun 2019 07:10:11 -0700
>>> Steve Kargl <sgk@troutmask.apl.washington.edu> wrote:
>>>
>>>> On Fri, Jun 21, 2019 at 02:31:51PM +0100, Mark Eggleston wrote:
>>>>> Currently variables with the AUTOMATIC attribute can not appear in an
>>>>> EQUIVALENCE statement. However its counterpart, STATIC, can be
>>>>> used in
>>>>> an EQUIVALENCE statement.
>>>>>
>>>>> Where there is a clear conflict in the attributes of variables in an
>>>>> EQUIVALENCE statement an error message will be issued as is currently
>>>>> the case.
>>>>>
>>>>> If there is no conflict e.g. a variable with a AUTOMATIC attribute
>>>>> and a
>>>>> variable(s) without attributes all variables in the EQUIVALENCE will
>>>>> become AUTOMATIC.
>>>>>
>>>>> Note: most of this patch was written by Jeff Law <law@redhat.com>
>>>>>
>>>>> Please review.
>>>>>
>>>>> ChangeLogs:
>>>>>
>>>>> gcc/fortran
>>>>>
>>>>>     Jeff Law <law@redhat.com>
>>>>>     Mark Eggleston <mark.eggleston@codethink.com>
>>>>>
>>>>> Â Â Â Â * gfortran.h: Add check_conflict declaration.
>>>> This is wrong. By convention a routine that is not static
>>>> has the gfc_ prefix.
Updated the code to use gfc_check_conflict instead.
>>>>
>>> Furthermore doesn't this export indicate that you're committing a
>>> layering violation somehow?
>> Possibly. I'm the original author, but my experience in our fortran
>> front-end is minimal. I fully expected this patch to need some
>> tweaking.
>>
>> We certainly don't want to recreate all the checking that's done in
>> check_conflict. We just need to defer it to a later point --
>> find_equivalence seemed like a good point since we've got the full
>> equivalence list handy and can accumulate the attributes across the
>> entire list, then check for conflicts.
>>
>> If there's a concrete place where you think we should be doing this, I'm
>> all ears.
>>
> Any suggestions will be appreciate.
>>>> Â Â Â Â * symbol.c (check_conflict): Remove automatic in equivalence
>>>> conflict
>>>> Â Â Â Â check.
>>>> Â Â Â Â * symbol.c (save_symbol): Add check for in equivalence to
>>>> stop the
>>>> Â Â Â Â the save attribute being added.
>>>> Â Â Â Â * trans-common.c (build_equiv_decl): Add is_auto parameter and
>>>> Â Â Â Â add !is_auto to condition where TREE_STATIC (decl) is set.
>>>> Â Â Â Â * trans-common.c (build_equiv_decl): Add local variable is_auto,
>>>> Â Â Â Â set it true if an atomatic attribute is encountered in the
>>>> variable
>>> atomatic? I read atomic but you mean automatic.
>> Yes.
>>
>>>>     list. Call build_equiv_decl with is_auto as an additional
>>>> parameter.
>>>> Â Â Â Â flag_dec_format_defaults is enabled.
>>>> Â Â Â Â * trans-common.c (accumulate_equivalence_attributes) : New
>>>> subroutine.
>>>> Â Â Â Â * trans-common.c (find_equivalence) : New local variable
>>>> dummy_symbol,
>>>> Â Â Â Â accumulated equivalence attributes from each symbol then
>>>> check for
>>>> Â Â Â Â conflicts.
>>> I'm just curious why you don't gfc_copy_attr for the most part of
>>> accumulate_equivalence_attributes?
>>> thanks,
>> Simply didn't know about it. It could probably significantly simplify
>> the accumulation of attributes step.
> Using gfc_copy_attr causes a great many "Duplicate DIMENSION attribute
> specified at (1)" errors. This is because there is a great deal of
> checking done instead of simply keeping track of the attributes used
> which is all that is required for determining whether there is a
> conflict in the equivalence statement.
>
> Also, the final section of accumulate_equivalence_attributes involving
> SAVE, INTENT and ACCESS look suspect to me. I'll check and update the
> patch if necessary.
No need to check intent as there is already a conflict with DUMMY and
INTENT can only be present for dummy variables.
Please find attached an updated patch. Change logs:
gcc/fortran
   Jeff Law <law@redhat.com>
   Mark Eggleston <mark.eggleston@codethink.com>
   * gfortran.h: Add gfc_check_conflict declaration.
   * symbol.c (check_conflict): Rename cfg_check_conflict and remove
   static.
   * symbol.c (cfg_check_conflict): Remove automatic in equivalence
   conflict check.
   * symbol.c (save_symbol): Add check for in equivalence to stop the
   the save attribute being added.
   * trans-common.c (build_equiv_decl): Add is_auto parameter and
   add !is_auto to condition where TREE_STATIC (decl) is set.
   * trans-common.c (build_equiv_decl): Add local variable is_auto,
   set it true if an atomatic attribute is encountered in the variable
   list. Call build_equiv_decl with is_auto as an additional parameter.
   flag_dec_format_defaults is enabled.
   * trans-common.c (accumulate_equivalence_attributes) : New subroutine.
   * trans-common.c (find_equivalence) : New local variable dummy_symbol,
   accumulated equivalence attributes from each symbol then check for
   conflicts.
gcc/testsuite
   Mark Eggleston <mark.eggleston@codethink.com>
   * gfortran.dg/auto_in_equiv_1.f90: New test.
   * gfortran.dg/auto_in_equiv_2.f90: New test.
   * gfortran.dg/auto_in_equiv_3.f90: New test.
If the updated patch is acceptable, please can someone with the
privileges commit the patch.
Mark
>
>> Jeff
>>
>>
>>
--
https://www.codethink.co.uk/privacy.html
[-- Attachment #2: 0001-Allow-automatics-in-equivalence.patch --]
[-- Type: text/x-patch, Size: 23777 bytes --]
From 321c7c84f9578e99ac0a1fa5f3ed1fd78b328d1f Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggleston@codethink.com>
Date: Tue, 11 Sep 2018 12:50:11 +0100
Subject: [PATCH 1/6] Allow automatics in equivalence
If a variable with an automatic attribute appears in an
equivalence statement the storage should be allocated on
the stack.
Note: most of this patch was provided by Jeff Law <law@redhat.com>.
---
gcc/fortran/gfortran.h | 1 +
gcc/fortran/symbol.c | 102 +++++++++++++-------------
gcc/fortran/trans-common.c | 73 ++++++++++++++++--
gcc/testsuite/gfortran.dg/auto_in_equiv_1.f90 | 36 +++++++++
gcc/testsuite/gfortran.dg/auto_in_equiv_2.f90 | 38 ++++++++++
gcc/testsuite/gfortran.dg/auto_in_equiv_3.f90 | 63 ++++++++++++++++
6 files changed, 257 insertions(+), 56 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/auto_in_equiv_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/auto_in_equiv_2.f90
create mode 100644 gcc/testsuite/gfortran.dg/auto_in_equiv_3.f90
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index b1f7bd0604a..573ae6c3bf3 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2996,6 +2996,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 gfc_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 f4273633db7..fbe563cd39a 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -407,8 +407,8 @@ gfc_check_function_type (gfc_namespace *ns)
goto conflict_std;\
}
-static bool
-check_conflict (symbol_attribute *attr, const char *name, locus *where)
+bool
+gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
{
static const char *dummy = "DUMMY", *save = "SAVE", *pointer = "POINTER",
*target = "TARGET", *external = "EXTERNAL", *intent = "INTENT",
@@ -544,7 +544,6 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf (allocatable, elemental);
conf (in_common, automatic);
- conf (in_equivalence, automatic);
conf (result, automatic);
conf (use_assoc, automatic);
conf (dummy, automatic);
@@ -1004,7 +1003,7 @@ gfc_add_attribute (symbol_attribute *attr, locus *where)
if (check_used (attr, NULL, where))
return false;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1030,7 +1029,7 @@ gfc_add_allocatable (symbol_attribute *attr, locus *where)
}
attr->allocatable = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1045,7 +1044,7 @@ gfc_add_automatic (symbol_attribute *attr, const char *name, locus *where)
return false;
attr->automatic = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1071,7 +1070,7 @@ gfc_add_codimension (symbol_attribute *attr, const char *name, locus *where)
}
attr->codimension = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1097,7 +1096,7 @@ gfc_add_dimension (symbol_attribute *attr, const char *name, locus *where)
}
attr->dimension = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1109,7 +1108,7 @@ gfc_add_contiguous (symbol_attribute *attr, const char *name, locus *where)
return false;
attr->contiguous = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1134,7 +1133,7 @@ gfc_add_external (symbol_attribute *attr, locus *where)
attr->external = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1153,7 +1152,7 @@ gfc_add_intrinsic (symbol_attribute *attr, locus *where)
attr->intrinsic = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1171,7 +1170,7 @@ gfc_add_optional (symbol_attribute *attr, locus *where)
}
attr->optional = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
bool
@@ -1184,7 +1183,7 @@ gfc_add_kind (symbol_attribute *attr, locus *where)
}
attr->pdt_kind = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
bool
@@ -1197,7 +1196,7 @@ gfc_add_len (symbol_attribute *attr, locus *where)
}
attr->pdt_len = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1222,7 +1221,7 @@ gfc_add_pointer (symbol_attribute *attr, locus *where)
else
attr->pointer = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1234,7 +1233,7 @@ gfc_add_cray_pointer (symbol_attribute *attr, locus *where)
return false;
attr->cray_pointer = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1253,7 +1252,7 @@ gfc_add_cray_pointee (symbol_attribute *attr, locus *where)
}
attr->cray_pointee = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1272,7 +1271,7 @@ gfc_add_protected (symbol_attribute *attr, const char *name, locus *where)
}
attr->is_protected = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1284,7 +1283,7 @@ gfc_add_result (symbol_attribute *attr, const char *name, locus *where)
return false;
attr->result = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1317,7 +1316,7 @@ gfc_add_save (symbol_attribute *attr, save_state s, const char *name,
}
attr->save = s;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1337,7 +1336,7 @@ gfc_add_value (symbol_attribute *attr, const char *name, locus *where)
}
attr->value = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1370,7 +1369,7 @@ gfc_add_volatile (symbol_attribute *attr, const char *name, locus *where)
attr->volatile_ = 1;
attr->volatile_ns = gfc_current_ns;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1389,7 +1388,7 @@ gfc_add_asynchronous (symbol_attribute *attr, const char *name, locus *where)
attr->asynchronous = 1;
attr->asynchronous_ns = gfc_current_ns;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1407,7 +1406,7 @@ gfc_add_threadprivate (symbol_attribute *attr, const char *name, locus *where)
}
attr->threadprivate = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1423,7 +1422,7 @@ gfc_add_omp_declare_target (symbol_attribute *attr, const char *name,
return true;
attr->omp_declare_target = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1439,7 +1438,7 @@ gfc_add_omp_declare_target_link (symbol_attribute *attr, const char *name,
return true;
attr->omp_declare_target_link = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1454,7 +1453,7 @@ gfc_add_oacc_declare_create (symbol_attribute *attr, const char *name,
return true;
attr->oacc_declare_create = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1469,7 +1468,7 @@ gfc_add_oacc_declare_copyin (symbol_attribute *attr, const char *name,
return true;
attr->oacc_declare_copyin = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1484,7 +1483,7 @@ gfc_add_oacc_declare_deviceptr (symbol_attribute *attr, const char *name,
return true;
attr->oacc_declare_deviceptr = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1499,7 +1498,7 @@ gfc_add_oacc_declare_device_resident (symbol_attribute *attr, const char *name,
return true;
attr->oacc_declare_device_resident = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1517,7 +1516,7 @@ gfc_add_target (symbol_attribute *attr, locus *where)
}
attr->target = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1530,7 +1529,7 @@ gfc_add_dummy (symbol_attribute *attr, const char *name, locus *where)
/* Duplicate dummy arguments are allowed due to ENTRY statements. */
attr->dummy = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1543,7 +1542,7 @@ gfc_add_in_common (symbol_attribute *attr, const char *name, locus *where)
/* Duplicate attribute already checked for. */
attr->in_common = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1553,7 +1552,7 @@ gfc_add_in_equivalence (symbol_attribute *attr, const char *name, locus *where)
/* Duplicate attribute already checked for. */
attr->in_equivalence = 1;
- if (!check_conflict (attr, name, where))
+ if (!gfc_check_conflict (attr, name, where))
return false;
if (attr->flavor == FL_VARIABLE)
@@ -1571,7 +1570,7 @@ gfc_add_data (symbol_attribute *attr, const char *name, locus *where)
return false;
attr->data = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1580,7 +1579,7 @@ gfc_add_in_namelist (symbol_attribute *attr, const char *name, locus *where)
{
attr->in_namelist = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1592,7 +1591,7 @@ gfc_add_sequence (symbol_attribute *attr, const char *name, locus *where)
return false;
attr->sequence = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1610,7 +1609,7 @@ gfc_add_elemental (symbol_attribute *attr, locus *where)
}
attr->elemental = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1628,7 +1627,7 @@ gfc_add_pure (symbol_attribute *attr, locus *where)
}
attr->pure = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1646,7 +1645,7 @@ gfc_add_recursive (symbol_attribute *attr, locus *where)
}
attr->recursive = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1664,7 +1663,7 @@ gfc_add_entry (symbol_attribute *attr, const char *name, locus *where)
}
attr->entry = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1677,7 +1676,7 @@ gfc_add_function (symbol_attribute *attr, const char *name, locus *where)
return false;
attr->function = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1696,7 +1695,7 @@ gfc_add_subroutine (symbol_attribute *attr, const char *name, locus *where)
compiler-generated), do not check. See PR 84394. */
if (name && *name != '_' && gfc_current_state () != COMP_BLOCK_DATA)
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
else
return true;
}
@@ -1711,7 +1710,7 @@ gfc_add_generic (symbol_attribute *attr, const char *name, locus *where)
return false;
attr->generic = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1734,7 +1733,7 @@ gfc_add_proc (symbol_attribute *attr, const char *name, locus *where)
attr->procedure = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1749,7 +1748,7 @@ gfc_add_abstract (symbol_attribute* attr, locus* where)
attr->abstract = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1795,7 +1794,7 @@ gfc_add_flavor (symbol_attribute *attr, sym_flavor f, const char *name,
attr->flavor = f;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1842,7 +1841,7 @@ gfc_add_procedure (symbol_attribute *attr, procedure_type t,
|| attr->dimension))
return false;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1856,7 +1855,7 @@ gfc_add_intent (symbol_attribute *attr, sym_intent intent, locus *where)
if (attr->intent == INTENT_UNKNOWN)
{
attr->intent = intent;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
if (where == NULL)
@@ -1881,7 +1880,7 @@ gfc_add_access (symbol_attribute *attr, gfc_access access,
|| (attr->use_assoc && attr->access != ACCESS_PRIVATE))
{
attr->access = access;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
if (where == NULL)
@@ -1913,7 +1912,7 @@ gfc_add_is_bind_c (symbol_attribute *attr, const char *name, locus *where,
if (!gfc_notify_std (GFC_STD_F2003, "BIND(C) at %L", where))
return false;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -4244,6 +4243,7 @@ save_symbol (gfc_symbol *sym)
return;
if (sym->attr.in_common
+ || sym->attr.in_equivalence
|| sym->attr.dummy
|| sym->attr.result
|| sym->attr.flavor != FL_VARIABLE)
diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index debdbd98ac0..775bbf91b2b 100644
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -339,7 +339,7 @@ build_field (segment_info *h, tree union_type, record_layout_info rli)
/* 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 @@ build_equiv_decl (tree union_type, bool is_init, bool is_saved)
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;
@@ -611,6 +611,7 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
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 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
/* 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 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
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)
{
@@ -948,6 +953,59 @@ 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.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 @@ find_equivalence (segment_info *n)
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 @@ find_equivalence (segment_info *n)
}
}
+ gfc_check_conflict (&dummy_symbol, e1->expr->symtree->name, &e1->expr->where);
+
/* Go to the next root element. */
if (eq == NULL)
continue;
diff --git a/gcc/testsuite/gfortran.dg/auto_in_equiv_1.f90 b/gcc/testsuite/gfortran.dg/auto_in_equiv_1.f90
new file mode 100644
index 00000000000..61bfd0738c5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_in_equiv_1.f90
@@ -0,0 +1,36 @@
+! { dg-compile }
+
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+program test
+ call suba(0)
+ call subb(0)
+ call suba(1)
+
+contains
+ subroutine suba(option)
+ integer, intent(in) :: option
+ integer, automatic :: a ! { dg-error "AUTOMATIC at \\(1\\) is a DEC extension" }
+ integer :: b
+ integer :: c
+ equivalence (a, b)
+ if (option.eq.0) then
+ ! initialise a and c
+ a = 9
+ c = 99
+ if (a.ne.b) stop 1
+ if (loc(a).ne.loc(b)) stop 2
+ else
+ ! a should've been overwritten
+ if (a.eq.9) stop 3
+ end if
+ end subroutine suba
+
+ subroutine subb(dummy)
+ integer, intent(in) :: dummy
+ integer, automatic :: x ! { dg-error "AUTOMATIC at \\(1\\) is a DEC extension" }
+ integer :: y
+ x = 77
+ y = 7
+ end subroutine subb
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/auto_in_equiv_2.f90 b/gcc/testsuite/gfortran.dg/auto_in_equiv_2.f90
new file mode 100644
index 00000000000..406e718604a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_in_equiv_2.f90
@@ -0,0 +1,38 @@
+! { dg-run }
+! { dg-options "-fdec-static" }
+
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+
+program test
+ call suba(0)
+ call subb(0)
+ call suba(1)
+
+contains
+ subroutine suba(option)
+ integer, intent(in) :: option
+ integer, automatic :: a
+ integer :: b
+ integer :: c
+ equivalence (a, b)
+ if (option.eq.0) then
+ ! initialise a and c
+ a = 9
+ c = 99
+ if (a.ne.b) stop 1
+ if (loc(a).ne.loc(b)) stop 2
+ else
+ ! a should've been overwritten
+ if (a.eq.9) stop 3
+ end if
+ end subroutine suba
+
+ subroutine subb(dummy)
+ integer, intent(in) :: dummy
+ integer, automatic :: x
+ integer :: y
+ x = 77
+ y = 7
+ end subroutine subb
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/auto_in_equiv_3.f90 b/gcc/testsuite/gfortran.dg/auto_in_equiv_3.f90
new file mode 100644
index 00000000000..c67aa8c6ac1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_in_equiv_3.f90
@@ -0,0 +1,63 @@
+! { dg-run }
+! { dg-options "-fdec-static -fno-automatic" }
+
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+
+! Storage is NOT on the static unless explicitly specified using the
+! DEC extension "automatic". The address of the first local variable
+! is used to determine that storage for the automatic local variable
+! is different to that of a local variable with no attributes. The
+! contents of the local variable in suba should be overwritten by the
+! call to subb.
+!
+program test
+ integer :: dummy
+ integer, parameter :: address = kind(loc(dummy))
+ integer(address) :: ad1
+ integer(address) :: ad2
+ integer(address) :: ad3
+ logical :: ok
+
+ call suba(0, ad1)
+ call subb(0, ad2)
+ call suba(1, ad1)
+ call subc(0, ad3)
+ ok = (ad1.eq.ad3).and.(ad1.ne.ad2)
+ if (.not.ok) stop 4
+
+contains
+ subroutine suba(option, addr)
+ integer, intent(in) :: option
+ integer(address), intent(out) :: addr
+ integer, automatic :: a
+ integer :: b
+ equivalence (a, b)
+ addr = loc(a)
+ if (option.eq.0) then
+ ! initialise a and c
+ a = 9
+ if (a.ne.b) stop 1
+ if (loc(a).ne.loc(b)) stop 2
+ else
+ ! a should've been overwritten
+ if (a.eq.9) stop 3
+ end if
+ end subroutine suba
+
+ subroutine subb(dummy, addr)
+ integer, intent(in) :: dummy
+ integer(address), intent(out) :: addr
+ integer :: x
+ addr = loc(x)
+ x = 77
+ end subroutine subb
+
+ subroutine subc(dummy, addr)
+ integer, intent(in) :: dummy
+ integer(address), intent(out) :: addr
+ integer, automatic :: y
+ addr = loc(y)
+ y = 77
+ end subroutine subc
+
+end program test
--
2.11.0
^ permalink raw reply [flat|nested] 10+ messages in thread
* **ping** Re: [PATCH] Automatics in equivalence statements
2019-07-01 9:35 ` Mark Eggleston
@ 2019-07-08 13:51 ` Mark Eggleston
2019-07-10 10:07 ` Mark Eggleston
2019-07-23 0:23 ` Jeff Law
1 sibling, 1 reply; 10+ messages in thread
From: Mark Eggleston @ 2019-07-08 13:51 UTC (permalink / raw)
To: Jeff Law, Bernhard Reutner-Fischer, Steve Kargl; +Cc: fortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 6098 bytes --]
**ping**
On 01/07/2019 10:35, Mark Eggleston wrote:
>
> On 25/06/2019 14:17, Mark Eggleston wrote:
>>
>> On 25/06/2019 00:17, Jeff Law wrote:
>>> On 6/24/19 2:19 AM, Bernhard Reutner-Fischer wrote:
>>>> On Fri, 21 Jun 2019 07:10:11 -0700
>>>> Steve Kargl <sgk@troutmask.apl.washington.edu> wrote:
>>>>
>>>>> On Fri, Jun 21, 2019 at 02:31:51PM +0100, Mark Eggleston wrote:
>>>>>> Currently variables with the AUTOMATIC attribute can not appear
>>>>>> in an
>>>>>> EQUIVALENCE statement. However its counterpart, STATIC, can be
>>>>>> used in
>>>>>> an EQUIVALENCE statement.
>>>>>>
>>>>>> Where there is a clear conflict in the attributes of variables in an
>>>>>> EQUIVALENCE statement an error message will be issued as is
>>>>>> currently
>>>>>> the case.
>>>>>>
>>>>>> If there is no conflict e.g. a variable with a AUTOMATIC
>>>>>> attribute and a
>>>>>> variable(s) without attributes all variables in the EQUIVALENCE will
>>>>>> become AUTOMATIC.
>>>>>>
>>>>>> Note: most of this patch was written by Jeff Law <law@redhat.com>
>>>>>>
>>>>>> Please review.
>>>>>>
>>>>>> ChangeLogs:
>>>>>>
>>>>>> gcc/fortran
>>>>>>
>>>>>>     Jeff Law <law@redhat.com>
>>>>>> Â Â Â Â Mark Eggleston <mark.eggleston@codethink.com>
>>>>>>
>>>>>> Â Â Â Â * gfortran.h: Add check_conflict declaration.
>>>>> This is wrong. By convention a routine that is not static
>>>>> has the gfc_ prefix.
> Updated the code to use gfc_check_conflict instead.
>>>>>
>>>> Furthermore doesn't this export indicate that you're committing a
>>>> layering violation somehow?
>>> Possibly. I'm the original author, but my experience in our fortran
>>> front-end is minimal. I fully expected this patch to need some
>>> tweaking.
>>>
>>> We certainly don't want to recreate all the checking that's done in
>>> check_conflict. We just need to defer it to a later point --
>>> find_equivalence seemed like a good point since we've got the full
>>> equivalence list handy and can accumulate the attributes across the
>>> entire list, then check for conflicts.
>>>
>>> If there's a concrete place where you think we should be doing this,
>>> I'm
>>> all ears.
>>>
>> Any suggestions will be appreciate.
>>>>> Â Â Â Â * symbol.c (check_conflict): Remove automatic in equivalence
>>>>> conflict
>>>>> Â Â Â Â check.
>>>>> Â Â Â Â * symbol.c (save_symbol): Add check for in equivalence to
>>>>> stop the
>>>>> Â Â Â Â the save attribute being added.
>>>>> Â Â Â Â * trans-common.c (build_equiv_decl): Add is_auto parameter and
>>>>> Â Â Â Â add !is_auto to condition where TREE_STATIC (decl) is set.
>>>>> Â Â Â Â * trans-common.c (build_equiv_decl): Add local variable
>>>>> is_auto,
>>>>> Â Â Â Â set it true if an atomatic attribute is encountered in the
>>>>> variable
>>>> atomatic? I read atomic but you mean automatic.
>>> Yes.
>>>
>>>>>     list. Call build_equiv_decl with is_auto as an additional
>>>>> parameter.
>>>>> Â Â Â Â flag_dec_format_defaults is enabled.
>>>>> Â Â Â Â * trans-common.c (accumulate_equivalence_attributes) : New
>>>>> subroutine.
>>>>> Â Â Â Â * trans-common.c (find_equivalence) : New local variable
>>>>> dummy_symbol,
>>>>> Â Â Â Â accumulated equivalence attributes from each symbol then
>>>>> check for
>>>>> Â Â Â Â conflicts.
>>>> I'm just curious why you don't gfc_copy_attr for the most part of
>>>> accumulate_equivalence_attributes?
>>>> thanks,
>>> Simply didn't know about it. It could probably significantly simplify
>>> the accumulation of attributes step.
>> Using gfc_copy_attr causes a great many "Duplicate DIMENSION
>> attribute specified at (1)" errors. This is because there is a great
>> deal of checking done instead of simply keeping track of the
>> attributes used which is all that is required for determining whether
>> there is a conflict in the equivalence statement.
>>
>> Also, the final section of accumulate_equivalence_attributes
>> involving SAVE, INTENT and ACCESS look suspect to me. I'll check and
>> update the patch if necessary.
>
> No need to check intent as there is already a conflict with DUMMY and
> INTENT can only be present for dummy variables.
>
> Please find attached an updated patch. Change logs:
>
> gcc/fortran
>
>    Jeff Law <law@redhat.com>
>    Mark Eggleston <mark.eggleston@codethink.com>
>
> Â Â Â * gfortran.h: Add gfc_check_conflict declaration.
> Â Â Â * symbol.c (check_conflict): Rename cfg_check_conflict and remove
> Â Â Â static.
> Â Â Â * symbol.c (cfg_check_conflict): Remove automatic in equivalence
> Â Â Â conflict check.
> Â Â Â * symbol.c (save_symbol): Add check for in equivalence to stop the
> Â Â Â the save attribute being added.
> Â Â Â * trans-common.c (build_equiv_decl): Add is_auto parameter and
> Â Â Â add !is_auto to condition where TREE_STATIC (decl) is set.
> Â Â Â * trans-common.c (build_equiv_decl): Add local variable is_auto,
> Â Â Â set it true if an atomatic attribute is encountered in the variable
>    list. Call build_equiv_decl with is_auto as an additional parameter.
> Â Â Â flag_dec_format_defaults is enabled.
> Â Â Â * trans-common.c (accumulate_equivalence_attributes) : New
> subroutine.
> Â Â Â * trans-common.c (find_equivalence) : New local variable
> dummy_symbol,
> Â Â Â accumulated equivalence attributes from each symbol then check for
> Â Â Â conflicts.
>
> gcc/testsuite
>
> Â Â Â Mark Eggleston <mark.eggleston@codethink.com>
>
> Â Â Â * gfortran.dg/auto_in_equiv_1.f90: New test.
> Â Â Â * gfortran.dg/auto_in_equiv_2.f90: New test.
> Â Â Â * gfortran.dg/auto_in_equiv_3.f90: New test.
>
> If the updated patch is acceptable, please can someone with the
> privileges commit the patch.
>
> Mark
>
>>
>>> Jeff
>>>
>>>
>>>
--
https://www.codethink.co.uk/privacy.html
[-- Attachment #2: 0001-Allow-automatics-in-equivalence.patch --]
[-- Type: text/x-patch, Size: 23777 bytes --]
From 321c7c84f9578e99ac0a1fa5f3ed1fd78b328d1f Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggleston@codethink.com>
Date: Tue, 11 Sep 2018 12:50:11 +0100
Subject: [PATCH 1/6] Allow automatics in equivalence
If a variable with an automatic attribute appears in an
equivalence statement the storage should be allocated on
the stack.
Note: most of this patch was provided by Jeff Law <law@redhat.com>.
---
gcc/fortran/gfortran.h | 1 +
gcc/fortran/symbol.c | 102 +++++++++++++-------------
gcc/fortran/trans-common.c | 73 ++++++++++++++++--
gcc/testsuite/gfortran.dg/auto_in_equiv_1.f90 | 36 +++++++++
gcc/testsuite/gfortran.dg/auto_in_equiv_2.f90 | 38 ++++++++++
gcc/testsuite/gfortran.dg/auto_in_equiv_3.f90 | 63 ++++++++++++++++
6 files changed, 257 insertions(+), 56 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/auto_in_equiv_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/auto_in_equiv_2.f90
create mode 100644 gcc/testsuite/gfortran.dg/auto_in_equiv_3.f90
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index b1f7bd0604a..573ae6c3bf3 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2996,6 +2996,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 gfc_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 f4273633db7..fbe563cd39a 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -407,8 +407,8 @@ gfc_check_function_type (gfc_namespace *ns)
goto conflict_std;\
}
-static bool
-check_conflict (symbol_attribute *attr, const char *name, locus *where)
+bool
+gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
{
static const char *dummy = "DUMMY", *save = "SAVE", *pointer = "POINTER",
*target = "TARGET", *external = "EXTERNAL", *intent = "INTENT",
@@ -544,7 +544,6 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf (allocatable, elemental);
conf (in_common, automatic);
- conf (in_equivalence, automatic);
conf (result, automatic);
conf (use_assoc, automatic);
conf (dummy, automatic);
@@ -1004,7 +1003,7 @@ gfc_add_attribute (symbol_attribute *attr, locus *where)
if (check_used (attr, NULL, where))
return false;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1030,7 +1029,7 @@ gfc_add_allocatable (symbol_attribute *attr, locus *where)
}
attr->allocatable = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1045,7 +1044,7 @@ gfc_add_automatic (symbol_attribute *attr, const char *name, locus *where)
return false;
attr->automatic = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1071,7 +1070,7 @@ gfc_add_codimension (symbol_attribute *attr, const char *name, locus *where)
}
attr->codimension = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1097,7 +1096,7 @@ gfc_add_dimension (symbol_attribute *attr, const char *name, locus *where)
}
attr->dimension = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1109,7 +1108,7 @@ gfc_add_contiguous (symbol_attribute *attr, const char *name, locus *where)
return false;
attr->contiguous = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1134,7 +1133,7 @@ gfc_add_external (symbol_attribute *attr, locus *where)
attr->external = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1153,7 +1152,7 @@ gfc_add_intrinsic (symbol_attribute *attr, locus *where)
attr->intrinsic = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1171,7 +1170,7 @@ gfc_add_optional (symbol_attribute *attr, locus *where)
}
attr->optional = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
bool
@@ -1184,7 +1183,7 @@ gfc_add_kind (symbol_attribute *attr, locus *where)
}
attr->pdt_kind = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
bool
@@ -1197,7 +1196,7 @@ gfc_add_len (symbol_attribute *attr, locus *where)
}
attr->pdt_len = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1222,7 +1221,7 @@ gfc_add_pointer (symbol_attribute *attr, locus *where)
else
attr->pointer = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1234,7 +1233,7 @@ gfc_add_cray_pointer (symbol_attribute *attr, locus *where)
return false;
attr->cray_pointer = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1253,7 +1252,7 @@ gfc_add_cray_pointee (symbol_attribute *attr, locus *where)
}
attr->cray_pointee = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1272,7 +1271,7 @@ gfc_add_protected (symbol_attribute *attr, const char *name, locus *where)
}
attr->is_protected = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1284,7 +1283,7 @@ gfc_add_result (symbol_attribute *attr, const char *name, locus *where)
return false;
attr->result = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1317,7 +1316,7 @@ gfc_add_save (symbol_attribute *attr, save_state s, const char *name,
}
attr->save = s;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1337,7 +1336,7 @@ gfc_add_value (symbol_attribute *attr, const char *name, locus *where)
}
attr->value = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1370,7 +1369,7 @@ gfc_add_volatile (symbol_attribute *attr, const char *name, locus *where)
attr->volatile_ = 1;
attr->volatile_ns = gfc_current_ns;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1389,7 +1388,7 @@ gfc_add_asynchronous (symbol_attribute *attr, const char *name, locus *where)
attr->asynchronous = 1;
attr->asynchronous_ns = gfc_current_ns;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1407,7 +1406,7 @@ gfc_add_threadprivate (symbol_attribute *attr, const char *name, locus *where)
}
attr->threadprivate = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1423,7 +1422,7 @@ gfc_add_omp_declare_target (symbol_attribute *attr, const char *name,
return true;
attr->omp_declare_target = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1439,7 +1438,7 @@ gfc_add_omp_declare_target_link (symbol_attribute *attr, const char *name,
return true;
attr->omp_declare_target_link = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1454,7 +1453,7 @@ gfc_add_oacc_declare_create (symbol_attribute *attr, const char *name,
return true;
attr->oacc_declare_create = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1469,7 +1468,7 @@ gfc_add_oacc_declare_copyin (symbol_attribute *attr, const char *name,
return true;
attr->oacc_declare_copyin = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1484,7 +1483,7 @@ gfc_add_oacc_declare_deviceptr (symbol_attribute *attr, const char *name,
return true;
attr->oacc_declare_deviceptr = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1499,7 +1498,7 @@ gfc_add_oacc_declare_device_resident (symbol_attribute *attr, const char *name,
return true;
attr->oacc_declare_device_resident = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1517,7 +1516,7 @@ gfc_add_target (symbol_attribute *attr, locus *where)
}
attr->target = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1530,7 +1529,7 @@ gfc_add_dummy (symbol_attribute *attr, const char *name, locus *where)
/* Duplicate dummy arguments are allowed due to ENTRY statements. */
attr->dummy = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1543,7 +1542,7 @@ gfc_add_in_common (symbol_attribute *attr, const char *name, locus *where)
/* Duplicate attribute already checked for. */
attr->in_common = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1553,7 +1552,7 @@ gfc_add_in_equivalence (symbol_attribute *attr, const char *name, locus *where)
/* Duplicate attribute already checked for. */
attr->in_equivalence = 1;
- if (!check_conflict (attr, name, where))
+ if (!gfc_check_conflict (attr, name, where))
return false;
if (attr->flavor == FL_VARIABLE)
@@ -1571,7 +1570,7 @@ gfc_add_data (symbol_attribute *attr, const char *name, locus *where)
return false;
attr->data = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1580,7 +1579,7 @@ gfc_add_in_namelist (symbol_attribute *attr, const char *name, locus *where)
{
attr->in_namelist = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1592,7 +1591,7 @@ gfc_add_sequence (symbol_attribute *attr, const char *name, locus *where)
return false;
attr->sequence = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1610,7 +1609,7 @@ gfc_add_elemental (symbol_attribute *attr, locus *where)
}
attr->elemental = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1628,7 +1627,7 @@ gfc_add_pure (symbol_attribute *attr, locus *where)
}
attr->pure = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1646,7 +1645,7 @@ gfc_add_recursive (symbol_attribute *attr, locus *where)
}
attr->recursive = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1664,7 +1663,7 @@ gfc_add_entry (symbol_attribute *attr, const char *name, locus *where)
}
attr->entry = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1677,7 +1676,7 @@ gfc_add_function (symbol_attribute *attr, const char *name, locus *where)
return false;
attr->function = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1696,7 +1695,7 @@ gfc_add_subroutine (symbol_attribute *attr, const char *name, locus *where)
compiler-generated), do not check. See PR 84394. */
if (name && *name != '_' && gfc_current_state () != COMP_BLOCK_DATA)
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
else
return true;
}
@@ -1711,7 +1710,7 @@ gfc_add_generic (symbol_attribute *attr, const char *name, locus *where)
return false;
attr->generic = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1734,7 +1733,7 @@ gfc_add_proc (symbol_attribute *attr, const char *name, locus *where)
attr->procedure = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1749,7 +1748,7 @@ gfc_add_abstract (symbol_attribute* attr, locus* where)
attr->abstract = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1795,7 +1794,7 @@ gfc_add_flavor (symbol_attribute *attr, sym_flavor f, const char *name,
attr->flavor = f;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1842,7 +1841,7 @@ gfc_add_procedure (symbol_attribute *attr, procedure_type t,
|| attr->dimension))
return false;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1856,7 +1855,7 @@ gfc_add_intent (symbol_attribute *attr, sym_intent intent, locus *where)
if (attr->intent == INTENT_UNKNOWN)
{
attr->intent = intent;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
if (where == NULL)
@@ -1881,7 +1880,7 @@ gfc_add_access (symbol_attribute *attr, gfc_access access,
|| (attr->use_assoc && attr->access != ACCESS_PRIVATE))
{
attr->access = access;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
if (where == NULL)
@@ -1913,7 +1912,7 @@ gfc_add_is_bind_c (symbol_attribute *attr, const char *name, locus *where,
if (!gfc_notify_std (GFC_STD_F2003, "BIND(C) at %L", where))
return false;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -4244,6 +4243,7 @@ save_symbol (gfc_symbol *sym)
return;
if (sym->attr.in_common
+ || sym->attr.in_equivalence
|| sym->attr.dummy
|| sym->attr.result
|| sym->attr.flavor != FL_VARIABLE)
diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index debdbd98ac0..775bbf91b2b 100644
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -339,7 +339,7 @@ build_field (segment_info *h, tree union_type, record_layout_info rli)
/* 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 @@ build_equiv_decl (tree union_type, bool is_init, bool is_saved)
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;
@@ -611,6 +611,7 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
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 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
/* 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 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
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)
{
@@ -948,6 +953,59 @@ 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.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 @@ find_equivalence (segment_info *n)
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 @@ find_equivalence (segment_info *n)
}
}
+ gfc_check_conflict (&dummy_symbol, e1->expr->symtree->name, &e1->expr->where);
+
/* Go to the next root element. */
if (eq == NULL)
continue;
diff --git a/gcc/testsuite/gfortran.dg/auto_in_equiv_1.f90 b/gcc/testsuite/gfortran.dg/auto_in_equiv_1.f90
new file mode 100644
index 00000000000..61bfd0738c5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_in_equiv_1.f90
@@ -0,0 +1,36 @@
+! { dg-compile }
+
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+program test
+ call suba(0)
+ call subb(0)
+ call suba(1)
+
+contains
+ subroutine suba(option)
+ integer, intent(in) :: option
+ integer, automatic :: a ! { dg-error "AUTOMATIC at \\(1\\) is a DEC extension" }
+ integer :: b
+ integer :: c
+ equivalence (a, b)
+ if (option.eq.0) then
+ ! initialise a and c
+ a = 9
+ c = 99
+ if (a.ne.b) stop 1
+ if (loc(a).ne.loc(b)) stop 2
+ else
+ ! a should've been overwritten
+ if (a.eq.9) stop 3
+ end if
+ end subroutine suba
+
+ subroutine subb(dummy)
+ integer, intent(in) :: dummy
+ integer, automatic :: x ! { dg-error "AUTOMATIC at \\(1\\) is a DEC extension" }
+ integer :: y
+ x = 77
+ y = 7
+ end subroutine subb
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/auto_in_equiv_2.f90 b/gcc/testsuite/gfortran.dg/auto_in_equiv_2.f90
new file mode 100644
index 00000000000..406e718604a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_in_equiv_2.f90
@@ -0,0 +1,38 @@
+! { dg-run }
+! { dg-options "-fdec-static" }
+
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+
+program test
+ call suba(0)
+ call subb(0)
+ call suba(1)
+
+contains
+ subroutine suba(option)
+ integer, intent(in) :: option
+ integer, automatic :: a
+ integer :: b
+ integer :: c
+ equivalence (a, b)
+ if (option.eq.0) then
+ ! initialise a and c
+ a = 9
+ c = 99
+ if (a.ne.b) stop 1
+ if (loc(a).ne.loc(b)) stop 2
+ else
+ ! a should've been overwritten
+ if (a.eq.9) stop 3
+ end if
+ end subroutine suba
+
+ subroutine subb(dummy)
+ integer, intent(in) :: dummy
+ integer, automatic :: x
+ integer :: y
+ x = 77
+ y = 7
+ end subroutine subb
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/auto_in_equiv_3.f90 b/gcc/testsuite/gfortran.dg/auto_in_equiv_3.f90
new file mode 100644
index 00000000000..c67aa8c6ac1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_in_equiv_3.f90
@@ -0,0 +1,63 @@
+! { dg-run }
+! { dg-options "-fdec-static -fno-automatic" }
+
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+
+! Storage is NOT on the static unless explicitly specified using the
+! DEC extension "automatic". The address of the first local variable
+! is used to determine that storage for the automatic local variable
+! is different to that of a local variable with no attributes. The
+! contents of the local variable in suba should be overwritten by the
+! call to subb.
+!
+program test
+ integer :: dummy
+ integer, parameter :: address = kind(loc(dummy))
+ integer(address) :: ad1
+ integer(address) :: ad2
+ integer(address) :: ad3
+ logical :: ok
+
+ call suba(0, ad1)
+ call subb(0, ad2)
+ call suba(1, ad1)
+ call subc(0, ad3)
+ ok = (ad1.eq.ad3).and.(ad1.ne.ad2)
+ if (.not.ok) stop 4
+
+contains
+ subroutine suba(option, addr)
+ integer, intent(in) :: option
+ integer(address), intent(out) :: addr
+ integer, automatic :: a
+ integer :: b
+ equivalence (a, b)
+ addr = loc(a)
+ if (option.eq.0) then
+ ! initialise a and c
+ a = 9
+ if (a.ne.b) stop 1
+ if (loc(a).ne.loc(b)) stop 2
+ else
+ ! a should've been overwritten
+ if (a.eq.9) stop 3
+ end if
+ end subroutine suba
+
+ subroutine subb(dummy, addr)
+ integer, intent(in) :: dummy
+ integer(address), intent(out) :: addr
+ integer :: x
+ addr = loc(x)
+ x = 77
+ end subroutine subb
+
+ subroutine subc(dummy, addr)
+ integer, intent(in) :: dummy
+ integer(address), intent(out) :: addr
+ integer, automatic :: y
+ addr = loc(y)
+ y = 77
+ end subroutine subc
+
+end program test
--
2.11.0
^ permalink raw reply [flat|nested] 10+ messages in thread
* Re: **ping** Re: [PATCH] Automatics in equivalence statements
2019-07-08 13:51 ` **ping** " Mark Eggleston
@ 2019-07-10 10:07 ` Mark Eggleston
0 siblings, 0 replies; 10+ messages in thread
From: Mark Eggleston @ 2019-07-10 10:07 UTC (permalink / raw)
To: Jeff Law, Bernhard Reutner-Fischer, Steve Kargl; +Cc: fortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 6453 bytes --]
Apologies typo in ChangeLog.
On 08/07/2019 14:51, Mark Eggleston wrote:
> **ping**
>
> On 01/07/2019 10:35, Mark Eggleston wrote:
>>
>> On 25/06/2019 14:17, Mark Eggleston wrote:
>>>
>>> On 25/06/2019 00:17, Jeff Law wrote:
>>>> On 6/24/19 2:19 AM, Bernhard Reutner-Fischer wrote:
>>>>> On Fri, 21 Jun 2019 07:10:11 -0700
>>>>> Steve Kargl <sgk@troutmask.apl.washington.edu> wrote:
>>>>>
>>>>>> On Fri, Jun 21, 2019 at 02:31:51PM +0100, Mark Eggleston wrote:
>>>>>>> Currently variables with the AUTOMATIC attribute can not appear
>>>>>>> in an
>>>>>>> EQUIVALENCE statement. However its counterpart, STATIC, can be
>>>>>>> used in
>>>>>>> an EQUIVALENCE statement.
>>>>>>>
>>>>>>> Where there is a clear conflict in the attributes of variables
>>>>>>> in an
>>>>>>> EQUIVALENCE statement an error message will be issued as is
>>>>>>> currently
>>>>>>> the case.
>>>>>>>
>>>>>>> If there is no conflict e.g. a variable with a AUTOMATIC
>>>>>>> attribute and a
>>>>>>> variable(s) without attributes all variables in the EQUIVALENCE
>>>>>>> will
>>>>>>> become AUTOMATIC.
>>>>>>>
>>>>>>> Note: most of this patch was written by Jeff Law <law@redhat.com>
>>>>>>>
>>>>>>> Please review.
>>>>>>>
>>>>>>> ChangeLogs:
>>>>>>>
>>>>>>> gcc/fortran
>>>>>>>
>>>>>>>     Jeff Law <law@redhat.com>
>>>>>>> Â Â Â Â Mark Eggleston <mark.eggleston@codethink.com>
>>>>>>>
>>>>>>> Â Â Â Â * gfortran.h: Add check_conflict declaration.
>>>>>> This is wrong. By convention a routine that is not static
>>>>>> has the gfc_ prefix.
>> Updated the code to use gfc_check_conflict instead.
>>>>>>
>>>>> Furthermore doesn't this export indicate that you're committing a
>>>>> layering violation somehow?
>>>> Possibly. I'm the original author, but my experience in our fortran
>>>> front-end is minimal. I fully expected this patch to need some
>>>> tweaking.
>>>>
>>>> We certainly don't want to recreate all the checking that's done in
>>>> check_conflict. We just need to defer it to a later point --
>>>> find_equivalence seemed like a good point since we've got the full
>>>> equivalence list handy and can accumulate the attributes across the
>>>> entire list, then check for conflicts.
>>>>
>>>> If there's a concrete place where you think we should be doing
>>>> this, I'm
>>>> all ears.
>>>>
>>> Any suggestions will be appreciate.
>>>>>> Â Â Â Â * symbol.c (check_conflict): Remove automatic in
>>>>>> equivalence conflict
>>>>>> Â Â Â Â check.
>>>>>> Â Â Â Â * symbol.c (save_symbol): Add check for in equivalence to
>>>>>> stop the
>>>>>> Â Â Â Â the save attribute being added.
>>>>>> Â Â Â Â * trans-common.c (build_equiv_decl): Add is_auto parameter and
>>>>>> Â Â Â Â add !is_auto to condition where TREE_STATIC (decl) is set.
>>>>>> Â Â Â Â * trans-common.c (build_equiv_decl): Add local variable
>>>>>> is_auto,
>>>>>> Â Â Â Â set it true if an atomatic attribute is encountered in the
>>>>>> variable
>>>>> atomatic? I read atomic but you mean automatic.
>>>> Yes.
>>>>
>>>>>>     list. Call build_equiv_decl with is_auto as an additional
>>>>>> parameter.
>>>>>> Â Â Â Â flag_dec_format_defaults is enabled.
>>>>>> Â Â Â Â * trans-common.c (accumulate_equivalence_attributes) : New
>>>>>> subroutine.
>>>>>> Â Â Â Â * trans-common.c (find_equivalence) : New local variable
>>>>>> dummy_symbol,
>>>>>> Â Â Â Â accumulated equivalence attributes from each symbol then
>>>>>> check for
>>>>>> Â Â Â Â conflicts.
>>>>> I'm just curious why you don't gfc_copy_attr for the most part of
>>>>> accumulate_equivalence_attributes?
>>>>> thanks,
>>>> Simply didn't know about it. It could probably significantly simplify
>>>> the accumulation of attributes step.
>>> Using gfc_copy_attr causes a great many "Duplicate DIMENSION
>>> attribute specified at (1)" errors. This is because there is a great
>>> deal of checking done instead of simply keeping track of the
>>> attributes used which is all that is required for determining
>>> whether there is a conflict in the equivalence statement.
>>>
>>> Also, the final section of accumulate_equivalence_attributes
>>> involving SAVE, INTENT and ACCESS look suspect to me. I'll check and
>>> update the patch if necessary.
>>
>> No need to check intent as there is already a conflict with DUMMY and
>> INTENT can only be present for dummy variables.
>>
>> Please find attached an updated patch. Change logs:
>>
>> gcc/fortran
>>
>>    Jeff Law <law@redhat.com>
>>    Mark Eggleston <mark.eggleston@codethink.com>
>>
>> Â Â Â * gfortran.h: Add gfc_check_conflict declaration.
>> Â Â Â * symbol.c (check_conflict): Rename cfg_check_conflict and remove
>> Â Â Â static.
>> Â Â Â * symbol.c (cfg_check_conflict): Remove automatic in equivalence
>> Â Â Â conflict check.
   * symbol.c (gfc_check_conflict): Remove automatic in equivalence
   conflict check.
>> Â Â Â * symbol.c (save_symbol): Add check for in equivalence to stop the
>> Â Â Â the save attribute being added.
>> Â Â Â * trans-common.c (build_equiv_decl): Add is_auto parameter and
>> Â Â Â add !is_auto to condition where TREE_STATIC (decl) is set.
>> Â Â Â * trans-common.c (build_equiv_decl): Add local variable is_auto,
>> Â Â Â set it true if an atomatic attribute is encountered in the variable
>>    list. Call build_equiv_decl with is_auto as an additional
>> parameter.
>> Â Â Â flag_dec_format_defaults is enabled.
>> Â Â Â * trans-common.c (accumulate_equivalence_attributes) : New
>> subroutine.
>> Â Â Â * trans-common.c (find_equivalence) : New local variable
>> dummy_symbol,
>> Â Â Â accumulated equivalence attributes from each symbol then check for
>> Â Â Â conflicts.
>>
>> gcc/testsuite
>>
>> Â Â Â Mark Eggleston <mark.eggleston@codethink.com>
>>
>> Â Â Â * gfortran.dg/auto_in_equiv_1.f90: New test.
>> Â Â Â * gfortran.dg/auto_in_equiv_2.f90: New test.
>> Â Â Â * gfortran.dg/auto_in_equiv_3.f90: New test.
>>
>> If the updated patch is acceptable, please can someone with the
>> privileges commit the patch.
>>
>> Mark
>>
>>>
>>>> Jeff
>>>>
>>>>
>>>>
--
https://www.codethink.co.uk/privacy.html
[-- Attachment #2: 0001-Allow-automatics-in-equivalence.patch --]
[-- Type: text/x-patch, Size: 23777 bytes --]
From 321c7c84f9578e99ac0a1fa5f3ed1fd78b328d1f Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggleston@codethink.com>
Date: Tue, 11 Sep 2018 12:50:11 +0100
Subject: [PATCH 1/6] Allow automatics in equivalence
If a variable with an automatic attribute appears in an
equivalence statement the storage should be allocated on
the stack.
Note: most of this patch was provided by Jeff Law <law@redhat.com>.
---
gcc/fortran/gfortran.h | 1 +
gcc/fortran/symbol.c | 102 +++++++++++++-------------
gcc/fortran/trans-common.c | 73 ++++++++++++++++--
gcc/testsuite/gfortran.dg/auto_in_equiv_1.f90 | 36 +++++++++
gcc/testsuite/gfortran.dg/auto_in_equiv_2.f90 | 38 ++++++++++
gcc/testsuite/gfortran.dg/auto_in_equiv_3.f90 | 63 ++++++++++++++++
6 files changed, 257 insertions(+), 56 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/auto_in_equiv_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/auto_in_equiv_2.f90
create mode 100644 gcc/testsuite/gfortran.dg/auto_in_equiv_3.f90
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index b1f7bd0604a..573ae6c3bf3 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2996,6 +2996,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 gfc_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 f4273633db7..fbe563cd39a 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -407,8 +407,8 @@ gfc_check_function_type (gfc_namespace *ns)
goto conflict_std;\
}
-static bool
-check_conflict (symbol_attribute *attr, const char *name, locus *where)
+bool
+gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
{
static const char *dummy = "DUMMY", *save = "SAVE", *pointer = "POINTER",
*target = "TARGET", *external = "EXTERNAL", *intent = "INTENT",
@@ -544,7 +544,6 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf (allocatable, elemental);
conf (in_common, automatic);
- conf (in_equivalence, automatic);
conf (result, automatic);
conf (use_assoc, automatic);
conf (dummy, automatic);
@@ -1004,7 +1003,7 @@ gfc_add_attribute (symbol_attribute *attr, locus *where)
if (check_used (attr, NULL, where))
return false;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1030,7 +1029,7 @@ gfc_add_allocatable (symbol_attribute *attr, locus *where)
}
attr->allocatable = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1045,7 +1044,7 @@ gfc_add_automatic (symbol_attribute *attr, const char *name, locus *where)
return false;
attr->automatic = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1071,7 +1070,7 @@ gfc_add_codimension (symbol_attribute *attr, const char *name, locus *where)
}
attr->codimension = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1097,7 +1096,7 @@ gfc_add_dimension (symbol_attribute *attr, const char *name, locus *where)
}
attr->dimension = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1109,7 +1108,7 @@ gfc_add_contiguous (symbol_attribute *attr, const char *name, locus *where)
return false;
attr->contiguous = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1134,7 +1133,7 @@ gfc_add_external (symbol_attribute *attr, locus *where)
attr->external = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1153,7 +1152,7 @@ gfc_add_intrinsic (symbol_attribute *attr, locus *where)
attr->intrinsic = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1171,7 +1170,7 @@ gfc_add_optional (symbol_attribute *attr, locus *where)
}
attr->optional = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
bool
@@ -1184,7 +1183,7 @@ gfc_add_kind (symbol_attribute *attr, locus *where)
}
attr->pdt_kind = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
bool
@@ -1197,7 +1196,7 @@ gfc_add_len (symbol_attribute *attr, locus *where)
}
attr->pdt_len = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1222,7 +1221,7 @@ gfc_add_pointer (symbol_attribute *attr, locus *where)
else
attr->pointer = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1234,7 +1233,7 @@ gfc_add_cray_pointer (symbol_attribute *attr, locus *where)
return false;
attr->cray_pointer = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1253,7 +1252,7 @@ gfc_add_cray_pointee (symbol_attribute *attr, locus *where)
}
attr->cray_pointee = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1272,7 +1271,7 @@ gfc_add_protected (symbol_attribute *attr, const char *name, locus *where)
}
attr->is_protected = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1284,7 +1283,7 @@ gfc_add_result (symbol_attribute *attr, const char *name, locus *where)
return false;
attr->result = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1317,7 +1316,7 @@ gfc_add_save (symbol_attribute *attr, save_state s, const char *name,
}
attr->save = s;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1337,7 +1336,7 @@ gfc_add_value (symbol_attribute *attr, const char *name, locus *where)
}
attr->value = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1370,7 +1369,7 @@ gfc_add_volatile (symbol_attribute *attr, const char *name, locus *where)
attr->volatile_ = 1;
attr->volatile_ns = gfc_current_ns;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1389,7 +1388,7 @@ gfc_add_asynchronous (symbol_attribute *attr, const char *name, locus *where)
attr->asynchronous = 1;
attr->asynchronous_ns = gfc_current_ns;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1407,7 +1406,7 @@ gfc_add_threadprivate (symbol_attribute *attr, const char *name, locus *where)
}
attr->threadprivate = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1423,7 +1422,7 @@ gfc_add_omp_declare_target (symbol_attribute *attr, const char *name,
return true;
attr->omp_declare_target = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1439,7 +1438,7 @@ gfc_add_omp_declare_target_link (symbol_attribute *attr, const char *name,
return true;
attr->omp_declare_target_link = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1454,7 +1453,7 @@ gfc_add_oacc_declare_create (symbol_attribute *attr, const char *name,
return true;
attr->oacc_declare_create = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1469,7 +1468,7 @@ gfc_add_oacc_declare_copyin (symbol_attribute *attr, const char *name,
return true;
attr->oacc_declare_copyin = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1484,7 +1483,7 @@ gfc_add_oacc_declare_deviceptr (symbol_attribute *attr, const char *name,
return true;
attr->oacc_declare_deviceptr = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1499,7 +1498,7 @@ gfc_add_oacc_declare_device_resident (symbol_attribute *attr, const char *name,
return true;
attr->oacc_declare_device_resident = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1517,7 +1516,7 @@ gfc_add_target (symbol_attribute *attr, locus *where)
}
attr->target = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1530,7 +1529,7 @@ gfc_add_dummy (symbol_attribute *attr, const char *name, locus *where)
/* Duplicate dummy arguments are allowed due to ENTRY statements. */
attr->dummy = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1543,7 +1542,7 @@ gfc_add_in_common (symbol_attribute *attr, const char *name, locus *where)
/* Duplicate attribute already checked for. */
attr->in_common = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1553,7 +1552,7 @@ gfc_add_in_equivalence (symbol_attribute *attr, const char *name, locus *where)
/* Duplicate attribute already checked for. */
attr->in_equivalence = 1;
- if (!check_conflict (attr, name, where))
+ if (!gfc_check_conflict (attr, name, where))
return false;
if (attr->flavor == FL_VARIABLE)
@@ -1571,7 +1570,7 @@ gfc_add_data (symbol_attribute *attr, const char *name, locus *where)
return false;
attr->data = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1580,7 +1579,7 @@ gfc_add_in_namelist (symbol_attribute *attr, const char *name, locus *where)
{
attr->in_namelist = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1592,7 +1591,7 @@ gfc_add_sequence (symbol_attribute *attr, const char *name, locus *where)
return false;
attr->sequence = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1610,7 +1609,7 @@ gfc_add_elemental (symbol_attribute *attr, locus *where)
}
attr->elemental = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1628,7 +1627,7 @@ gfc_add_pure (symbol_attribute *attr, locus *where)
}
attr->pure = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1646,7 +1645,7 @@ gfc_add_recursive (symbol_attribute *attr, locus *where)
}
attr->recursive = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1664,7 +1663,7 @@ gfc_add_entry (symbol_attribute *attr, const char *name, locus *where)
}
attr->entry = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1677,7 +1676,7 @@ gfc_add_function (symbol_attribute *attr, const char *name, locus *where)
return false;
attr->function = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1696,7 +1695,7 @@ gfc_add_subroutine (symbol_attribute *attr, const char *name, locus *where)
compiler-generated), do not check. See PR 84394. */
if (name && *name != '_' && gfc_current_state () != COMP_BLOCK_DATA)
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
else
return true;
}
@@ -1711,7 +1710,7 @@ gfc_add_generic (symbol_attribute *attr, const char *name, locus *where)
return false;
attr->generic = 1;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1734,7 +1733,7 @@ gfc_add_proc (symbol_attribute *attr, const char *name, locus *where)
attr->procedure = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1749,7 +1748,7 @@ gfc_add_abstract (symbol_attribute* attr, locus* where)
attr->abstract = 1;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
@@ -1795,7 +1794,7 @@ gfc_add_flavor (symbol_attribute *attr, sym_flavor f, const char *name,
attr->flavor = f;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1842,7 +1841,7 @@ gfc_add_procedure (symbol_attribute *attr, procedure_type t,
|| attr->dimension))
return false;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -1856,7 +1855,7 @@ gfc_add_intent (symbol_attribute *attr, sym_intent intent, locus *where)
if (attr->intent == INTENT_UNKNOWN)
{
attr->intent = intent;
- return check_conflict (attr, NULL, where);
+ return gfc_check_conflict (attr, NULL, where);
}
if (where == NULL)
@@ -1881,7 +1880,7 @@ gfc_add_access (symbol_attribute *attr, gfc_access access,
|| (attr->use_assoc && attr->access != ACCESS_PRIVATE))
{
attr->access = access;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
if (where == NULL)
@@ -1913,7 +1912,7 @@ gfc_add_is_bind_c (symbol_attribute *attr, const char *name, locus *where,
if (!gfc_notify_std (GFC_STD_F2003, "BIND(C) at %L", where))
return false;
- return check_conflict (attr, name, where);
+ return gfc_check_conflict (attr, name, where);
}
@@ -4244,6 +4243,7 @@ save_symbol (gfc_symbol *sym)
return;
if (sym->attr.in_common
+ || sym->attr.in_equivalence
|| sym->attr.dummy
|| sym->attr.result
|| sym->attr.flavor != FL_VARIABLE)
diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index debdbd98ac0..775bbf91b2b 100644
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -339,7 +339,7 @@ build_field (segment_info *h, tree union_type, record_layout_info rli)
/* 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 @@ build_equiv_decl (tree union_type, bool is_init, bool is_saved)
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;
@@ -611,6 +611,7 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
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 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
/* 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 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
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)
{
@@ -948,6 +953,59 @@ 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.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 @@ find_equivalence (segment_info *n)
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 @@ find_equivalence (segment_info *n)
}
}
+ gfc_check_conflict (&dummy_symbol, e1->expr->symtree->name, &e1->expr->where);
+
/* Go to the next root element. */
if (eq == NULL)
continue;
diff --git a/gcc/testsuite/gfortran.dg/auto_in_equiv_1.f90 b/gcc/testsuite/gfortran.dg/auto_in_equiv_1.f90
new file mode 100644
index 00000000000..61bfd0738c5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_in_equiv_1.f90
@@ -0,0 +1,36 @@
+! { dg-compile }
+
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+program test
+ call suba(0)
+ call subb(0)
+ call suba(1)
+
+contains
+ subroutine suba(option)
+ integer, intent(in) :: option
+ integer, automatic :: a ! { dg-error "AUTOMATIC at \\(1\\) is a DEC extension" }
+ integer :: b
+ integer :: c
+ equivalence (a, b)
+ if (option.eq.0) then
+ ! initialise a and c
+ a = 9
+ c = 99
+ if (a.ne.b) stop 1
+ if (loc(a).ne.loc(b)) stop 2
+ else
+ ! a should've been overwritten
+ if (a.eq.9) stop 3
+ end if
+ end subroutine suba
+
+ subroutine subb(dummy)
+ integer, intent(in) :: dummy
+ integer, automatic :: x ! { dg-error "AUTOMATIC at \\(1\\) is a DEC extension" }
+ integer :: y
+ x = 77
+ y = 7
+ end subroutine subb
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/auto_in_equiv_2.f90 b/gcc/testsuite/gfortran.dg/auto_in_equiv_2.f90
new file mode 100644
index 00000000000..406e718604a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_in_equiv_2.f90
@@ -0,0 +1,38 @@
+! { dg-run }
+! { dg-options "-fdec-static" }
+
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+
+program test
+ call suba(0)
+ call subb(0)
+ call suba(1)
+
+contains
+ subroutine suba(option)
+ integer, intent(in) :: option
+ integer, automatic :: a
+ integer :: b
+ integer :: c
+ equivalence (a, b)
+ if (option.eq.0) then
+ ! initialise a and c
+ a = 9
+ c = 99
+ if (a.ne.b) stop 1
+ if (loc(a).ne.loc(b)) stop 2
+ else
+ ! a should've been overwritten
+ if (a.eq.9) stop 3
+ end if
+ end subroutine suba
+
+ subroutine subb(dummy)
+ integer, intent(in) :: dummy
+ integer, automatic :: x
+ integer :: y
+ x = 77
+ y = 7
+ end subroutine subb
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/auto_in_equiv_3.f90 b/gcc/testsuite/gfortran.dg/auto_in_equiv_3.f90
new file mode 100644
index 00000000000..c67aa8c6ac1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_in_equiv_3.f90
@@ -0,0 +1,63 @@
+! { dg-run }
+! { dg-options "-fdec-static -fno-automatic" }
+
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
+
+! Storage is NOT on the static unless explicitly specified using the
+! DEC extension "automatic". The address of the first local variable
+! is used to determine that storage for the automatic local variable
+! is different to that of a local variable with no attributes. The
+! contents of the local variable in suba should be overwritten by the
+! call to subb.
+!
+program test
+ integer :: dummy
+ integer, parameter :: address = kind(loc(dummy))
+ integer(address) :: ad1
+ integer(address) :: ad2
+ integer(address) :: ad3
+ logical :: ok
+
+ call suba(0, ad1)
+ call subb(0, ad2)
+ call suba(1, ad1)
+ call subc(0, ad3)
+ ok = (ad1.eq.ad3).and.(ad1.ne.ad2)
+ if (.not.ok) stop 4
+
+contains
+ subroutine suba(option, addr)
+ integer, intent(in) :: option
+ integer(address), intent(out) :: addr
+ integer, automatic :: a
+ integer :: b
+ equivalence (a, b)
+ addr = loc(a)
+ if (option.eq.0) then
+ ! initialise a and c
+ a = 9
+ if (a.ne.b) stop 1
+ if (loc(a).ne.loc(b)) stop 2
+ else
+ ! a should've been overwritten
+ if (a.eq.9) stop 3
+ end if
+ end subroutine suba
+
+ subroutine subb(dummy, addr)
+ integer, intent(in) :: dummy
+ integer(address), intent(out) :: addr
+ integer :: x
+ addr = loc(x)
+ x = 77
+ end subroutine subb
+
+ subroutine subc(dummy, addr)
+ integer, intent(in) :: dummy
+ integer(address), intent(out) :: addr
+ integer, automatic :: y
+ addr = loc(y)
+ y = 77
+ end subroutine subc
+
+end program test
--
2.11.0
^ permalink raw reply [flat|nested] 10+ messages in thread
* Re: [PATCH] Automatics in equivalence statements
2019-07-01 9:35 ` Mark Eggleston
2019-07-08 13:51 ` **ping** " Mark Eggleston
@ 2019-07-23 0:23 ` Jeff Law
1 sibling, 0 replies; 10+ messages in thread
From: Jeff Law @ 2019-07-23 0:23 UTC (permalink / raw)
To: Mark Eggleston, Bernhard Reutner-Fischer, Steve Kargl
Cc: fortran, gcc-patches
On 7/1/19 3:35 AM, Mark Eggleston wrote:
>
> On 25/06/2019 14:17, Mark Eggleston wrote:
>>
>> On 25/06/2019 00:17, Jeff Law wrote:
>>> On 6/24/19 2:19 AM, Bernhard Reutner-Fischer wrote:
>>>> On Fri, 21 Jun 2019 07:10:11 -0700
>>>> Steve Kargl <sgk@troutmask.apl.washington.edu> wrote:
>>>>
>>>>> On Fri, Jun 21, 2019 at 02:31:51PM +0100, Mark Eggleston wrote:
>>>>>> Currently variables with the AUTOMATIC attribute can not appear in an
>>>>>> EQUIVALENCE statement. However its counterpart, STATIC, can be
>>>>>> used in
>>>>>> an EQUIVALENCE statement.
>>>>>>
>>>>>> Where there is a clear conflict in the attributes of variables in an
>>>>>> EQUIVALENCE statement an error message will be issued as is currently
>>>>>> the case.
>>>>>>
>>>>>> If there is no conflict e.g. a variable with a AUTOMATIC attribute
>>>>>> and a
>>>>>> variable(s) without attributes all variables in the EQUIVALENCE will
>>>>>> become AUTOMATIC.
>>>>>>
>>>>>> Note: most of this patch was written by Jeff Law <law@redhat.com>
>>>>>>
>>>>>> Please review.
>>>>>>
>>>>>> ChangeLogs:
>>>>>>
>>>>>> gcc/fortran
>>>>>>
>>>>>>     Jeff Law <law@redhat.com>
>>>>>>     Mark Eggleston <mark.eggleston@codethink.com>
>>>>>>
>>>>>> Â Â Â Â * gfortran.h: Add check_conflict declaration.
>>>>> This is wrong. By convention a routine that is not static
>>>>> has the gfc_ prefix.
> Updated the code to use gfc_check_conflict instead.
>>>>>
>>>> Furthermore doesn't this export indicate that you're committing a
>>>> layering violation somehow?
>>> Possibly. I'm the original author, but my experience in our fortran
>>> front-end is minimal. I fully expected this patch to need some
>>> tweaking.
>>>
>>> We certainly don't want to recreate all the checking that's done in
>>> check_conflict. We just need to defer it to a later point --
>>> find_equivalence seemed like a good point since we've got the full
>>> equivalence list handy and can accumulate the attributes across the
>>> entire list, then check for conflicts.
>>>
>>> If there's a concrete place where you think we should be doing this, I'm
>>> all ears.
>>>
>> Any suggestions will be appreciate.
>>>>> Â Â Â Â * symbol.c (check_conflict): Remove automatic in equivalence
>>>>> conflict
>>>>> Â Â Â Â check.
>>>>> Â Â Â Â * symbol.c (save_symbol): Add check for in equivalence to
>>>>> stop the
>>>>> Â Â Â Â the save attribute being added.
>>>>> Â Â Â Â * trans-common.c (build_equiv_decl): Add is_auto parameter and
>>>>> Â Â Â Â add !is_auto to condition where TREE_STATIC (decl) is set.
>>>>> Â Â Â Â * trans-common.c (build_equiv_decl): Add local variable is_auto,
>>>>> Â Â Â Â set it true if an atomatic attribute is encountered in the
>>>>> variable
>>>> atomatic? I read atomic but you mean automatic.
>>> Yes.
>>>
>>>>>     list. Call build_equiv_decl with is_auto as an additional
>>>>> parameter.
>>>>> Â Â Â Â flag_dec_format_defaults is enabled.
>>>>> Â Â Â Â * trans-common.c (accumulate_equivalence_attributes) : New
>>>>> subroutine.
>>>>> Â Â Â Â * trans-common.c (find_equivalence) : New local variable
>>>>> dummy_symbol,
>>>>> Â Â Â Â accumulated equivalence attributes from each symbol then
>>>>> check for
>>>>> Â Â Â Â conflicts.
>>>> I'm just curious why you don't gfc_copy_attr for the most part of
>>>> accumulate_equivalence_attributes?
>>>> thanks,
>>> Simply didn't know about it. It could probably significantly simplify
>>> the accumulation of attributes step.
>> Using gfc_copy_attr causes a great many "Duplicate DIMENSION attribute
>> specified at (1)" errors. This is because there is a great deal of
>> checking done instead of simply keeping track of the attributes used
>> which is all that is required for determining whether there is a
>> conflict in the equivalence statement.
>>
>> Also, the final section of accumulate_equivalence_attributes involving
>> SAVE, INTENT and ACCESS look suspect to me. I'll check and update the
>> patch if necessary.
>
> No need to check intent as there is already a conflict with DUMMY and
> INTENT can only be present for dummy variables.
>
> Please find attached an updated patch. Change logs:
>
> gcc/fortran
>
>    Jeff Law <law@redhat.com>
>    Mark Eggleston <mark.eggleston@codethink.com>
>
> Â Â Â * gfortran.h: Add gfc_check_conflict declaration.
> Â Â Â * symbol.c (check_conflict): Rename cfg_check_conflict and remove
> Â Â Â static.
> Â Â Â * symbol.c (cfg_check_conflict): Remove automatic in equivalence
> Â Â Â conflict check.
> Â Â Â * symbol.c (save_symbol): Add check for in equivalence to stop the
> Â Â Â the save attribute being added.
> Â Â Â * trans-common.c (build_equiv_decl): Add is_auto parameter and
> Â Â Â add !is_auto to condition where TREE_STATIC (decl) is set.
> Â Â Â * trans-common.c (build_equiv_decl): Add local variable is_auto,
> Â Â Â set it true if an atomatic attribute is encountered in the variable
>    list. Call build_equiv_decl with is_auto as an additional parameter.
> Â Â Â flag_dec_format_defaults is enabled.
> Â Â Â * trans-common.c (accumulate_equivalence_attributes) : New subroutine.
> Â Â Â * trans-common.c (find_equivalence) : New local variable dummy_symbol,
> Â Â Â accumulated equivalence attributes from each symbol then check for
> Â Â Â conflicts.
>
> gcc/testsuite
>
> Â Â Â Mark Eggleston <mark.eggleston@codethink.com>
>
> Â Â Â * gfortran.dg/auto_in_equiv_1.f90: New test.
> Â Â Â * gfortran.dg/auto_in_equiv_2.f90: New test.
> Â Â Â * gfortran.dg/auto_in_equiv_3.f90: New test.
>
> If the updated patch is acceptable, please can someone with the
> privileges commit the patch.
[ ... ]
BTW, I've put the latest version of this into my tester. I don't expect
to see any problems, of course.
Jeff
^ permalink raw reply [flat|nested] 10+ messages in thread
end of thread, other threads:[~2019-07-23 0:19 UTC | newest]
Thread overview: 10+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2019-06-21 13:31 [PATCH] Automatics in equivalence statements Mark Eggleston
2019-06-21 14:10 ` Steve Kargl
2019-06-24 8:19 ` Bernhard Reutner-Fischer
2019-06-24 13:47 ` Mark Eggleston
2019-06-24 23:18 ` Jeff Law
2019-06-25 13:17 ` Mark Eggleston
2019-07-01 9:35 ` Mark Eggleston
2019-07-08 13:51 ` **ping** " Mark Eggleston
2019-07-10 10:07 ` Mark Eggleston
2019-07-23 0:23 ` Jeff Law
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).