diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2022-12-09 22:13:45 +0100 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2022-12-18 21:02:34 +0100 |
| commit | 6f2f588377e6437ae23fb83aa2c85e03e1f41678 (patch) | |
| tree | e7a538282b61f756980167a04cf3aa4b5c0ffa63 /gcc | |
| parent | e85a0a23873c09acb039973b27c573ec62ad5b77 (diff) | |
| download | gcc-6f2f588377e6437ae23fb83aa2c85e03e1f41678.zip gcc-6f2f588377e6437ae23fb83aa2c85e03e1f41678.tar.gz gcc-6f2f588377e6437ae23fb83aa2c85e03e1f41678.tar.bz2 | |
Fortran: ICE on recursive derived types with allocatable components [PR107872]
gcc/fortran/ChangeLog:
PR fortran/107872
* resolve.c (derived_inaccessible): Skip over allocatable components
to prevent an infinite loop.
gcc/testsuite/ChangeLog:
PR fortran/107872
* gfortran.dg/pr107872.f90: New test.
(cherry picked from commit 01254aa2eb766c7584fd047568d7277d4d65d067)
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/resolve.c | 3 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pr107872.f90 | 40 |
2 files changed, 42 insertions, 1 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 15c88b2..591d3b8 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -7440,7 +7440,8 @@ derived_inaccessible (gfc_symbol *sym) for (c = sym->components; c; c = c->next) { /* Prevent an infinite loop through this function. */ - if (c->ts.type == BT_DERIVED && c->attr.pointer + if (c->ts.type == BT_DERIVED + && (c->attr.pointer || c->attr.allocatable) && sym == c->ts.u.derived) continue; diff --git a/gcc/testsuite/gfortran.dg/pr107872.f90 b/gcc/testsuite/gfortran.dg/pr107872.f90 new file mode 100644 index 0000000..0983847 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr107872.f90 @@ -0,0 +1,40 @@ +! { dg-do run } +! +! Test the fix for PR107872, where an ICE occurred in +! resolve.cc(derived_inaccessible) because derived types with +! recursive allocatable components were not catered for. +! +module mod1 + type t + integer :: data + type(t), allocatable :: next + contains + procedure, private :: write_t + generic :: write(formatted) => write_t + end type +contains + recursive subroutine write_t(this, unit, iotype, v_list, iostat, iomsg) + class(t), intent(in) :: this + integer, intent(in) :: unit + character(*), intent(in) :: iotype + integer, intent(in) :: v_list(:) + integer, intent(out) :: iostat + character(*), intent(inout) :: iomsg + if (ALLOCATED(this%next)) & + write (unit, '(dt)') this%next + write (unit, '(i2)') this%data + end subroutine +end module + + use mod1 + type(t) :: a + character (8) :: buffer + a%data = 1 + allocate (a%next) + a%next%data = 2 + allocate (a%next%next) + a%next%next%data = 3 + write (buffer, '(dt)')a + deallocate (a%next) + if (trim (buffer) .ne. ' 3 2 1') stop 1 +end |