From: Andre Vehreschild <vehre@gcc.gnu.org>
Date: Tue, 25 Feb 2025 16:15:47 +0000 (+0100)
Subject: Fortran: Fix ICE on associate of pointer [PR118789]
X-Git-Tag: basepoints/gcc-16~1827
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=0fc1abcc46ecc34e8d2d7ec7167656ede2cd5690;p=thirdparty%2Fgcc.git

Fortran: Fix ICE on associate of pointer [PR118789]

Fix ICE when associating a pointer to void (c_ptr) by looking at the
compatibility of the type hierarchy.

	PR fortran/118789

gcc/fortran/ChangeLog:

	* trans-stmt.cc (trans_associate_var): Compare pointed to types when
	expr to associate is already a pointer.

gcc/testsuite/ChangeLog:

	* gfortran.dg/associate_73.f90: New test.
---

diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index e7da8fea3b2..f16e1e3b46e 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2287,7 +2287,12 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
 		  tmp = se.expr;
 		}
 	    }
-	  if (!POINTER_TYPE_P (TREE_TYPE (se.expr)))
+	  /* For non-pointer types in se.expr, the first condition holds.
+	     For pointer or reference types in se.expr, a double TREE_TYPE ()
+	     is possible and an associate variable always is a pointer.  */
+	  if (!POINTER_TYPE_P (TREE_TYPE (se.expr))
+	      || TREE_TYPE (TREE_TYPE (se.expr))
+		   != TREE_TYPE (TREE_TYPE (sym->backend_decl)))
 	    tmp = gfc_build_addr_expr (tmp, se.expr);
 	}
 
diff --git a/gcc/testsuite/gfortran.dg/associate_73.f90 b/gcc/testsuite/gfortran.dg/associate_73.f90
new file mode 100644
index 00000000000..a5c3ca79b9c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_73.f90
@@ -0,0 +1,21 @@
+!{ dg-do compile }
+
+! Check associate to a "void *" does not ICE.
+! Contributed by Matthias Klose  <doko@gcc.gnu.org>
+! and Steve Kargl  <kargls@comcast.net>
+
+module pr118789
+
+   implicit none
+
+   CONTAINS
+
+   subroutine fckit_c_nodelete(cptr) bind(c)
+      use, intrinsic :: iso_c_binding
+      type(c_ptr), value :: cptr
+      associate( unused_ => cptr )
+      end associate
+   end subroutine
+
+end module
+