diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2023-03-21 06:22:37 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2023-03-21 06:22:37 +0000 |
| commit | 3a9caf7883103bc3a80dfc9e4797bb849b3c211c (patch) | |
| tree | f03539e063a8462281667b45c5242e6783933291 /gcc | |
| parent | 76dda10584011fa8156d13cb24b3649f1765b68f (diff) | |
| download | gcc-3a9caf7883103bc3a80dfc9e4797bb849b3c211c.zip gcc-3a9caf7883103bc3a80dfc9e4797bb849b3c211c.tar.gz gcc-3a9caf7883103bc3a80dfc9e4797bb849b3c211c.tar.bz2 | |
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.
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/resolve.cc | 1 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pr109209.f90 | 80 |
2 files changed, 81 insertions, 0 deletions
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 1d973d1..1a03e45 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 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 |