Automatics in equivalence statements

Message ID 01b19cf0-7854-90a7-a2cd-14750dfcf543@codethink.co.uk
State New
Headers show
Series
  • Automatics in equivalence statements
Related show

Commit Message

Mark Eggleston June 21, 2019, 1:31 p.m.
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

Comments

Steve Kargl June 21, 2019, 2:10 p.m. | #1
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
Bernhard Reutner-Fischer June 24, 2019, 8:19 a.m. | #2
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,
Mark Eggleston June 24, 2019, 1:47 p.m. | #3
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
Jeff Law June 24, 2019, 11:17 p.m. | #4
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
Mark Eggleston June 25, 2019, 1:17 p.m. | #5
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
Mark Eggleston July 1, 2019, 9:35 a.m. | #6
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
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
Jeff Law July 23, 2019, 12:19 a.m. | #7
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

Patch

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