From 7a9741d7322357c4e777450891e43db27e067817 Mon Sep 17 00:00:00 2001
From: Paul Thomas <pault@gcc.gnu.org>
Date: Fri, 9 Dec 2022 22:13:45 +0100
Subject: [PATCH 293/547] Fortran: ICE on recursive derived types with
 allocatable components [PR107872]

gcc/fortran/ChangeLog:

	PR fortran/107872
	* resolve.cc (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)
---
 gcc/fortran/resolve.cc                 |  3 +-
 gcc/testsuite/gfortran.dg/pr107872.f90 | 40 ++++++++++++++++++++++++++
 2 files changed, 42 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr107872.f90

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 29df531cdb6..f4b5441622e 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -7528,7 +7528,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 00000000000..09838479e92
--- /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
-- 
2.25.1

