Fortran: Fix regression caused by PR37336 patch [PR109209]

2023-03-21  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/109209
	* resolve.cc (generate_component_assignments): Restore the
	exclusion of allocatable components from the loop.

gcc/testsuite/
	PR fortran/109209
	* gfortran.dg/pr109209.f90: New test.

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 1d973d12ff103714828b298ac5d0aedfaf616aad..1a03e458d9931c13c7d5ec2cada369f19a48dafa 100644 (file)
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -11760,6 +11760,7 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns)
         of all kinds and allocatable components.  */
       if (!gfc_bt_struct (comp1->ts.type)
          || comp1->attr.pointer
+         || comp1->attr.allocatable
          || comp1->attr.proc_pointer_comp
          || comp1->attr.class_pointer
          || comp1->attr.proc_pointer)

diff --git a/gcc/testsuite/gfortran.dg/pr109209.f90 b/gcc/testsuite/gfortran.dg/pr109209.f90
new file mode 100644 (file)
index 0000000..5ee7389
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr109209.f90
@@ -0,0 +1,80 @@
+! { dg-do compile }
+!
+! Fix for a regression caused by
+! r13-6747-gd7caf313525a46f200d7f5db1ba893f853774aee
+!
+! Contributed by Juergen Reuter  <juergen.reuter@desy.de>
+!
+module resonances
+  implicit none
+  private
+
+  type :: t1_t
+     integer, dimension(:), allocatable :: c
+   contains
+     procedure, private :: t1_assign
+     generic :: assignment(=) => t1_assign
+  end type t1_t
+
+  type :: t3_t
+     type(t1_t), dimension(:), allocatable :: resonances
+     integer :: n_resonances = 0
+  contains
+     procedure, private :: t3_assign
+     generic :: assignment(=) => t3_assign
+  end type t3_t
+
+  type :: resonance_branch_t
+     integer :: i = 0
+     integer, dimension(:), allocatable :: r_child
+     integer, dimension(:), allocatable :: o_child
+  end type resonance_branch_t
+
+  type :: resonance_tree_t
+     private
+     integer :: n = 0
+     type(resonance_branch_t), dimension(:), allocatable :: branch
+  end type resonance_tree_t
+
+  type :: t3_set_t
+     private
+     type(t3_t), dimension(:), allocatable :: history
+     type(resonance_tree_t), dimension(:), allocatable :: tree
+     integer :: last = 0
+   contains
+     procedure, private :: expand => t3_set_expand
+  end type t3_set_t
+
+contains
+
+  pure subroutine t1_assign &
+       (t1_out, t1_in)
+    class(t1_t), intent(inout) :: t1_out
+    class(t1_t), intent(in) :: t1_in
+    if (allocated (t1_out%c))  deallocate (t1_out%c)
+    if (allocated (t1_in%c)) then
+       allocate (t1_out%c (size (t1_in%c)))
+       t1_out%c = t1_in%c
+    end if
+  end subroutine t1_assign
+
+  subroutine t3_assign (res_hist_out, res_hist_in)
+    class(t3_t), intent(out) :: res_hist_out
+    class(t3_t), intent(in) :: res_hist_in
+    if (allocated (res_hist_in%resonances)) then
+       res_hist_out%resonances = res_hist_in%resonances
+       res_hist_out%n_resonances = res_hist_in%n_resonances
+    end if
+  end subroutine t3_assign
+
+  subroutine t3_set_expand (res_set)
+    class(t3_set_t), intent(inout) :: res_set
+    type(t3_t), dimension(:), allocatable :: history_new
+    integer :: s
+    s = size (res_set%history)
+    allocate (history_new (2 * s))
+    history_new(1:s) = res_set%history(1:s)
+    call move_alloc (history_new, res_set%history)
+  end subroutine t3_set_expand
+
+end module resonances