From: Paul Thomas <pault@gcc.gnu.org>
Date: Tue, 21 Apr 2026 14:00:14 +0000 (+0100)
Subject: Fortran: ICE due to allocatable component in hidden type [PR117077]
X-Git-Tag: basepoints/gcc-17~31
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=062dcf033eaac7385feb1b2daafb8c22628f9e8f;p=thirdparty%2Fgcc.git

Fortran: ICE due to allocatable component in hidden type [PR117077]

2026-03-19  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/117077
	* trans-expr.cc (gfc_trans_scalar_assign): If the lhs and rhs
	TYPE_MAIN_VARIANTs are not the same, convert the rhs to the lhs
	type via a VIEW_CONVERT_EXPR.

gcc/testsuite/
	PR fortran/117077
	* gfortran.dg/pr117077.f90: New test.
---

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 3b9a9337984..2f14e8c3f6c 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11850,8 +11850,16 @@ gfc_trans_scalar_assign (gfc_se *lse, gfc_se *rse, gfc_typespec ts,
 
       gfc_add_block_to_block (&block, &lse->pre);
 
-      gfc_add_modify (&block, lse->expr,
-			   fold_convert (TREE_TYPE (lse->expr), rse->expr));
+      if (TYPE_MAIN_VARIANT (TREE_TYPE (lse->expr))
+	  == TYPE_MAIN_VARIANT (TREE_TYPE (rse->expr)))
+	gfc_add_modify (&block, lse->expr,
+			fold_convert (TREE_TYPE (lse->expr), rse->expr));
+      else
+	{
+	  tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
+				 TREE_TYPE (lse->expr), rse->expr);
+	  gfc_add_modify (&block, lse->expr, tmp);
+	}
 
       /* Restore pointer address of coarray components.  */
       if (ts.u.derived->attr.coarray_comp && deep_copy && tmp_var != NULL_TREE)
diff --git a/gcc/testsuite/gfortran.dg/pr117077.f90 b/gcc/testsuite/gfortran.dg/pr117077.f90
new file mode 100644
index 00000000000..9206569b6d9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr117077.f90
@@ -0,0 +1,56 @@
+! { dg-do run }
+!
+! Test the fix for PR117077. The test has been made more elaborate that the
+! original to demonstrate that the hidden derived type can be used as a container
+! for returning processed/verified versions of a number of variables.
+!
+! Contributed by Ivan Pribec  <ivan.pribec@gmail.com>
+!
+module hidden
+  implicit none
+  private
+  public :: foo
+contains
+  type(foo_type) function foo(a1, a2, a3) result(f)
+    integer, intent(in) :: a1
+    real(kind(1.0d0)), intent(in) :: a2
+    real(kind(1.0e0)), intent(in) :: a3(3)
+    type :: foo_type
+      integer :: first
+      real(kind(1.0d0)) :: second
+      real, allocatable :: third(:)
+    end type
+    f = foo_type(a1 - 1, a2 / 2.0, a3 * 2)
+  end function
+end module
+
+program main
+  use hidden
+  type :: main_type
+    integer :: first
+    real(kind(1.0d0)) :: second
+    real, allocatable :: third(:)
+  end type
+
+  integer :: a1 = 42
+  real(kind(1.0d0)) :: a2 = 5.0d0
+  real(kind(1.0e0)) :: a3(3) = [1.0,2.0,3.0]
+  type(main_type) :: g
+
+  associate(f => foo(a1, a2, a3)) ! ICE in the assignment of foo result to f
+    if (f%first /= a1 - 1) stop 1
+    if (int (f%second) /= int(a2 / 2.0)) stop 2
+    if (kind (f%second) /= kind (a2)) stop 3
+    if (.not.allocated(f%third)) stop 4
+    if (any (abs (f%third - a3 * 2) > 1e-6)) stop 5
+  end associate
+
+  g = transfer (foo(a1, a2, a3), mold = g)
+  if (g%first /= a1 - 1) stop 11
+  if (int (g%second) /= int(a2 / 2.0)) stop 12
+  if (kind (g%second) /= kind (a2)) stop 13
+  if (.not.allocated(g%third)) stop 14
+  if (any (abs (g%third - a3 * 2) > 1e-6)) stop 15
+
+  deallocate (g%third)
+end program