From 3a9caf7883103bc3a80dfc9e4797bb849b3c211c Mon Sep 17 00:00:00 2001
From: Paul Thomas <pault@gcc.gnu.org>
Date: Tue, 21 Mar 2023 06:22:37 +0000
Subject: [PATCH] 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.
---
gcc/fortran/resolve.cc | 1 +
gcc/testsuite/gfortran.dg/pr109209.f90 | 80 ++++++++++++++++++++++++++
2 files changed, 81 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/pr109209.f90
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 1d973d12ff10..1a03e458d993 100644
--- 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
index 000000000000..5ee7389400ee
--- /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
--
GitLab