From: Paul Thomas <pault@gcc.gnu.org>
Date: Tue, 7 Oct 2025 12:30:43 +0000 (+0100)
Subject: Fortran: Fix ICE in pdt_1[3-5].f03 with -fcheck=all [PR102901]
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=05d3dd6010a53e93e1693001eba4c88a7face53b;p=thirdparty%2Fgcc.git

Fortran: Fix ICE in pdt_1[3-5].f03 with -fcheck=all [PR102901]

2025-10-07  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/102901
	* trans-array.cc (structure_alloc_comps): Do not use
	gfc_check_pdt_dummy with pointer or allocatable components.

gcc/testsuite/
	PR fortran/102901
	* gfortran.dg/pdt_56.f03: Copy of pdt_13.f03 compiled with
	-fcheck=all.
---

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index db34de44401..9dd61f98ca7 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -11180,7 +11180,11 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
 	    comp = gfc_class_data_get (comp);
 
 	  /* Recurse in to PDT components.  */
-	  if ((c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS)
+	  if (((c->ts.type == BT_DERIVED
+		&& !c->attr.allocatable && !c->attr.pointer)
+	       || (c->ts.type == BT_CLASS
+		   && !CLASS_DATA (c)->attr.allocatable
+		   && !CLASS_DATA (c)->attr.pointer))
 	      && c->ts.u.derived && c->ts.u.derived->attr.pdt_type)
 	    {
 	      tmp = gfc_check_pdt_dummy (c->ts.u.derived, comp,
diff --git a/gcc/testsuite/gfortran.dg/pdt_56.f03 b/gcc/testsuite/gfortran.dg/pdt_56.f03
new file mode 100644
index 00000000000..681d4793702
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_56.f03
@@ -0,0 +1,96 @@
+! { dg-do compile }
+! { dg-options "-fcheck=all" }
+!
+! Test the fix for PR102901, where pdt_13/14/15.f03 segfaulted in compilation
+! with -fcheck=all.
+!
+! Reported by Tobias Burnus  <burnus@gcc.gnu.org>
+!
+! This is pdt_13.f03.
+!
+module precision_module
+  implicit none
+  integer, parameter :: sp = selected_real_kind(6, 37)
+  integer, parameter :: dp = selected_real_kind(15, 307)
+  integer, parameter :: qp = selected_real_kind( 30, 291)
+end module precision_module
+
+module link_module
+  use precision_module
+
+  type link(real_kind)
+    integer, kind :: real_kind
+    real (kind=real_kind) :: n
+    type (link(real_kind)), pointer :: next => NULL()
+  end type link
+
+contains
+
+  function push_8 (self, arg) result(current)
+    real(dp) :: arg
+    type (link(real_kind=dp)), pointer :: self
+    type (link(real_kind=dp)), pointer :: current
+
+    if (associated (self)) then
+      current => self
+      do while (associated (current%next))
+        current => current%next
+      end do
+
+      allocate (current%next)
+      current => current%next
+    else
+      allocate (current)
+      self => current
+    end if
+
+    current%n = arg
+    current%next => NULL ()
+  end function push_8
+
+  function pop_8 (self) result(res)
+    type (link(real_kind=dp)), pointer :: self
+    type (link(real_kind=dp)), pointer :: current => NULL()
+    type (link(real_kind=dp)), pointer :: previous => NULL()
+    real(dp) :: res
+
+    res = 0.0_8
+    if (associated (self)) then
+      current => self
+      do while (associated (current) .and. associated (current%next))
+         previous => current
+         current => current%next
+      end do
+
+      previous%next => NULL ()
+
+      res = current%n
+      if (associated (self, current)) then
+        deallocate (self)
+      else
+        deallocate (current)
+      end if
+
+    end if
+  end function pop_8
+
+end module link_module
+
+program ch2701
+  use precision_module
+  use link_module
+  implicit none
+  integer, parameter :: wp = dp
+  type (link(real_kind=wp)), pointer :: root => NULL()
+  type (link(real_kind=wp)), pointer :: current
+
+  current => push_8 (root, 1.0_8)
+  current => push_8 (root, 2.0_8)
+  current => push_8 (root, 3.0_8)
+
+  if (int (pop_8 (root)) .ne. 3) STOP 1
+  if (int (pop_8 (root)) .ne. 2) STOP 2
+  if (int (pop_8 (root)) .ne. 1) STOP 3
+  if (int (pop_8 (root)) .ne. 0) STOP 4
+
+end program ch2701