Allow automatics in equivalences

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

From-SVN: r274565

gcc/fortran/ChangeLog

+2019-08-16  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.
+  
 2019-08-16  Richard Biener  <rguenther@suse.de>
 
 	* trans-intrinsic.c (gfc_conv_intrinsic_findloc): Initialize

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 *);

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;

gcc/testsuite/ChangeLog

+2019-08-16  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.
+
 2019-08-16  Richard Biener  <rguenther@suse.de>
 
 	* gcc.dg/tree-ssa/forwprop-31.c: Adjust.

gcc/testsuite/gfortran.dg/auto_in_equiv_1.f90

+! { 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

gcc/testsuite/gfortran.dg/auto_in_equiv_2.f90

+! { 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

gcc/testsuite/gfortran.dg/auto_in_equiv_3.f90

+! { 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