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 3b9a9337984a116bfd3d57be128b5fdf49f7875d..2f14e8c3f6cd0e993cba8b1460dbb320ea0bd502 100644 (file)
--- 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 (file)
index 0000000..9206569
--- /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