fortran: [PR121475] Function result not finalized.

	PR fortran/121475

gcc/fortran/ChangeLog:

	* trans.cc (gfc_finalize_tree_expr): Add logic to allow the
	function result to be resolved in resolve.cc
	(generate_component_assignments).

gcc/testsuite/ChangeLog:

	* gfortran.dg/pr121475.f90: New test as posted in the PR
	from Christopher Albert

Signed-off-by: Andrew Benson <abensonca@gcc.gnu.org>

diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 47396c3cbab1f767087d6598e7b2e68a378e539e..dcacf94e4130cf27cafe1024b137d8ad2837f16a 100644 (file)
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1623,7 +1623,10 @@ gfc_finalize_tree_expr (gfc_se *se, gfc_symbol *derived,
   if (derived && (derived->attr.is_c_interop
                  || derived->attr.is_iso_c
                  || derived->attr.is_bind_c
-                 || derived->attr.defined_assign_comp))
+                 || (derived->attr.extension && derived->f2k_derived
+                     && derived->f2k_derived->tb_op[INTRINSIC_ASSIGN])
+                 || (!derived->attr.extension
+                     && derived->attr.defined_assign_comp)))
     return;
 
   if (is_class)

diff --git a/gcc/testsuite/gfortran.dg/pr121475.f90 b/gcc/testsuite/gfortran.dg/pr121475.f90
new file mode 100644 (file)
index 0000000..ab3a8c0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr121475.f90
@@ -0,0 +1,75 @@
+! { dg-do run }
+!
+! PR fortran/121475 - Function result not finalized when passed to
+! user-defined assignment.
+!
+! F2003 4.5.5.2 requires that function results be finalized after
+! execution of the innermost executable construct.  When the function
+! result is passed to a user-defined assignment, the finalization was
+! being skipped because of early return for types with defined_assign_comp.
+
+! Test case put together by Christopher Albert.
+
+module m
+  implicit none
+  integer :: final_count = 0
+
+  type :: base
+  contains
+    procedure :: assign
+    generic :: assignment(=) => assign
+  end type
+
+  type, extends(base) :: derived
+    integer :: val
+  contains
+    final :: finalize
+  end type
+
+  interface derived
+    module procedure constructor
+  end interface
+
+contains
+
+  subroutine finalize(self)
+    type(derived), intent(inout) :: self
+    final_count = final_count + 1
+  end subroutine
+
+  function constructor() result(self)
+    type(derived) :: self
+    self%val = 0
+  end function
+
+  subroutine assign(to, from)
+    class(base), intent(out) :: to
+    class(base), intent(in) :: from
+    select type (to)
+    type is (derived)
+      select type (from)
+      type is (derived)
+        to%val = from%val
+      end select
+    end select
+  end subroutine
+
+end module
+
+program test
+  use m
+  implicit none
+
+  block
+    type(derived) :: obj
+
+    final_count = 0
+    obj = derived()
+
+    ! Function result and intermediate temporaries finalized
+    if (final_count /= 2) stop 1
+  end block
+
+  ! obj goes out of scope, finalized again
+  if (final_count /= 3) stop 2
+end program