[PATCH] Automatics in equivalence statements

[PATCH] Automatics in equivalence statements

[Mark Eggleston]

[-- 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

Re: [PATCH] Automatics in equivalence statements

[Steve Kargl]

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

Re: [PATCH] Automatics in equivalence statements

[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,

Re: [PATCH] Automatics in equivalence statements

[Mark Eggleston]

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

Re: [PATCH] Automatics in equivalence statements

[Jeff Law]

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

Re: [PATCH] Automatics in equivalence statements

[Mark Eggleston]

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

Re: [PATCH] Automatics in equivalence statements

[Mark Eggleston]

[-- 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

**ping** Re: [PATCH] Automatics in equivalence statements

[Mark Eggleston]

[-- 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

Re: **ping** Re: [PATCH] Automatics in equivalence statements

[Mark Eggleston]

[-- 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

Re: [PATCH] Automatics in equivalence statements

[Jeff Law]

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

Re: [PATCH] Automatics in equivalence statements

[Mark Eggleston]

Thanks, as you point out all the test needs to do is verify that that a 
variable with an AUTOMATIC attribute can be used in an EQUIVALENCE and 
and that the items in the EQUIVALENCE are on the stack by using in a 
recursive routine.

I've created a patch to replace the existing test cases and have sent it 
to this e-mail thread https://gcc.gnu.org/ml/fortran/2019-09/msg00123.html

regards,

Mark

On 30/09/2019 11:24, Jakub Jelinek wrote:
> On Sat, Sep 28, 2019 at 10:33:26PM +0200, Andreas Schwab wrote:
>> On Aug 14 2019, Mark Eggleston <mark.eggleston@codethink.co.uk> wrote:
>>
>>>      * gfortran.dg/auto_in_equiv_3.f90: New test.
>> This test fails everywhere.
> Yes, and _2 on i686-linux at -O0.
>
> To me both testcases are undefined behavior.
> E.g. the first one has:
>    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
> My understanding is that because a is explicitly automatic and b is automatic too
> (implicitly), the whole equivalence is automatic, so if you call this
> subroutine with non-zero option, you read an uninitialized variable and
> compare it to 9.  That can result in anything, .false., .true., disk
> formatting, you can't rely on some other routine laying out its automatic
> variable at exactly the same spot and overwriting the memory in there, not
> to mention that the compiler can easily spot the uninitialized use too.
> Similarly in the second test, returning address of an automatic variable
> from a function is already something e.g. the C/C++ FEs warn about, because
> you really can't do anything useful with that address, it can't be
> dereferenced, or even the comparisons to addresses of other automatic
> variables that left their scope is wrong.
>
> IMHO if you want to check if a variable is SAVEd or AUTOMATIC, you want to
> recurse, either directly or indirectly, pass the address of the variable in
> the outer subroutine down to the inner one and compare there, SAVEd
> variables need to have the same address, while AUTOMATIC variables where
> both the outer and inner variable is at that point still in the scope need
> to have the addresses different.
>
> Though, in order to have in Fortran a recursively callable subroutine, one
> needs to use RECURSIVE.
> So, IMHO we want 4 testcases out of these 2, two dg-do compile only which
> will verify the tests compile when mixing automatic with no explicit
> save/automatic in equivalence and will -fdump-tree-gimple and scan the
> gimple dump to verify there is equiv.\[0-9]* variable which is not static,
> and then two runtime testcases like (one with just -fdec-static, one with
> also -fno-automatic, though guess it doesn't matter that much, as recursive
> already implies that it is automatic).
> program test
>    integer :: dummy
>    integer, parameter :: address = kind(loc(dummy))
>    integer(address) :: addr
>    addr = 0
>    call sub (0, addr)
> contains
>    recursive subroutine sub (option, addr)
>      integer, intent(in) :: option
>      integer(address), intent(in) :: addr
>      integer, automatic :: a
>      integer :: b
>      integer(address) :: c
>      equivalence (a, b)
>      if (option.eq.0) then
>        a = 9
>        if (a.ne.b) stop 1
>        if (loc(a).ne.loc(b)) stop 2
>        c = loc(a)
>        call sub (1, c)
>        if (a.ne.9) stop 3
>      else
>        a = 10
>        if (a.ne.b) stop 4
>        if (loc(a).ne.loc(b)) stop 5
>        if (addr.eq.loc(a)) stop 6
>      end if
>    end subroutine sub
> end program test
>
> 	Jakub
>
-- 
https://www.codethink.co.uk/privacy.html

Re: [PATCH] Automatics in equivalence statements

[Jakub Jelinek]

On Sat, Sep 28, 2019 at 10:33:26PM +0200, Andreas Schwab wrote:
> On Aug 14 2019, Mark Eggleston <mark.eggleston@codethink.co.uk> wrote:
> 
> >     * gfortran.dg/auto_in_equiv_3.f90: New test.
> 
> This test fails everywhere.

Yes, and _2 on i686-linux at -O0.

To me both testcases are undefined behavior.
E.g. the first one has:
  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
My understanding is that because a is explicitly automatic and b is automatic too
(implicitly), the whole equivalence is automatic, so if you call this
subroutine with non-zero option, you read an uninitialized variable and
compare it to 9.  That can result in anything, .false., .true., disk
formatting, you can't rely on some other routine laying out its automatic
variable at exactly the same spot and overwriting the memory in there, not
to mention that the compiler can easily spot the uninitialized use too.
Similarly in the second test, returning address of an automatic variable
from a function is already something e.g. the C/C++ FEs warn about, because
you really can't do anything useful with that address, it can't be
dereferenced, or even the comparisons to addresses of other automatic
variables that left their scope is wrong.

IMHO if you want to check if a variable is SAVEd or AUTOMATIC, you want to
recurse, either directly or indirectly, pass the address of the variable in
the outer subroutine down to the inner one and compare there, SAVEd
variables need to have the same address, while AUTOMATIC variables where
both the outer and inner variable is at that point still in the scope need
to have the addresses different.

Though, in order to have in Fortran a recursively callable subroutine, one
needs to use RECURSIVE.
So, IMHO we want 4 testcases out of these 2, two dg-do compile only which
will verify the tests compile when mixing automatic with no explicit
save/automatic in equivalence and will -fdump-tree-gimple and scan the
gimple dump to verify there is equiv.\[0-9]* variable which is not static,
and then two runtime testcases like (one with just -fdec-static, one with
also -fno-automatic, though guess it doesn't matter that much, as recursive
already implies that it is automatic).
program test
  integer :: dummy
  integer, parameter :: address = kind(loc(dummy))
  integer(address) :: addr
  addr = 0
  call sub (0, addr)
contains
  recursive subroutine sub (option, addr)
    integer, intent(in) :: option
    integer(address), intent(in) :: addr
    integer, automatic :: a
    integer :: b
    integer(address) :: c
    equivalence (a, b)
    if (option.eq.0) then
      a = 9
      if (a.ne.b) stop 1
      if (loc(a).ne.loc(b)) stop 2
      c = loc(a)
      call sub (1, c)
      if (a.ne.9) stop 3
    else
      a = 10
      if (a.ne.b) stop 4
      if (loc(a).ne.loc(b)) stop 5
      if (addr.eq.loc(a)) stop 6
    end if
  end subroutine sub
end program test

	Jakub

Re: [PATCH] Automatics in equivalence statements

[Andreas Schwab]

On Aug 14 2019, Mark Eggleston <mark.eggleston@codethink.co.uk> wrote:

>     * gfortran.dg/auto_in_equiv_3.f90: New test.

This test fails everywhere.

Andreas.

-- 
Andreas Schwab, schwab@linux-m68k.org
GPG Key fingerprint = 7578 EB47 D4E5 4D69 2510  2552 DF73 E780 A9DA AEC1
"And now for something completely different."

Re: [PATCH] Automatics in equivalence statements

[Mark Eggleston]

On 14/08/2019 18:10, Jeff Law wrote:
> On 8/14/19 2:45 AM, Mark Eggleston wrote:
>> I now have commit access.
>>
>> 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.
>>
>> OK to commit?
>>
>> How do I know that I have approval to commit?
> Yes, this is OK to commit.  Steve acked it in a private message to me.
Committed as revision 274565.
> Normally you'll get an ACK/OK on the public list.  But private ACKs or
> ACKs on IRC also count as approval :-)
>
> jeff
>
-- 
https://www.codethink.co.uk/privacy.html

Re: [PATCH] Automatics in equivalence statements

[Jeff Law]

On 8/14/19 2:45 AM, Mark Eggleston wrote:
> I now have commit access.
> 
> 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.
> 
> OK to commit?
> 
> How do I know that I have approval to commit?
Yes, this is OK to commit.  Steve acked it in a private message to me.

Normally you'll get an ACK/OK on the public list.  But private ACKs or
ACKs on IRC also count as approval :-)

jeff

Re: [PATCH] Automatics in equivalence statements

[Mark Eggleston]

[-- Attachment #1: Type: text/plain, Size: 2235 bytes --]

I now have commit access.

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.

OK to commit?

How do I know that I have approval to commit?

On 23/07/2019 03:50, Jeff Law wrote:
> On 7/22/19 8:36 PM, Steve Kargl wrote:
>> On Mon, Jul 22, 2019 at 08:07:12PM -0600, Jeff Law wrote:
>>> On 7/22/19 7:38 PM, Steve Kargl wrote:
>>>> Someone needs to get commit access.
>>>>
>>> I've sent Mark the link for authenticated access.  So is he clear to
>>> commit once that's set up?
>>>
>>> jeff
>> Yes, IMHO.  He's sent a number of quality patches, and
>> from what I gathered you've worked with him so he has
>> a good mentor.
> Perfect.  THanks.
>
>> Unfortunately, gfortran has too few contributors at the moment.
> Y'all aren't alone...
>
> Jeff
>
>
-- 
https://www.codethink.co.uk/privacy.html


[-- Attachment #2: 0002-Allow-automatics-in-equivalence.patch --]
[-- Type: text/x-patch, Size: 23777 bytes --]

From 8487aa2c195261f62489f94c2e2d16d81f945362 Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggleston@codethink.com>
Date: Tue, 11 Sep 2018 12:50:11 +0100
Subject: [PATCH 2/3] 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 75e5b2f0644..49bcacc9a54 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3007,6 +3007,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 2b8f86e0881..cc5b5efa3a8 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 9fc23ff5e7c..18ad60fd657 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