aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHarald Anlauf <anlauf@gmx.de>2025-03-26 22:04:39 +0100
committerHarald Anlauf <anlauf@gmx.de>2025-03-26 22:52:37 +0100
commitb70bd691cfd77b4d7a453031599bb6f1d48aedf1 (patch)
tree590d2274d9ec139d85853d15b486941fd2f12891
parentfc749717001436d49ed34aec6b034670f5a3fbcd (diff)
downloadgcc-b70bd691cfd77b4d7a453031599bb6f1d48aedf1.zip
gcc-b70bd691cfd77b4d7a453031599bb6f1d48aedf1.tar.gz
gcc-b70bd691cfd77b4d7a453031599bb6f1d48aedf1.tar.bz2
Fortran: fix bogus recursion with DT default initialization [PR118796]
PR fortran/118796 gcc/fortran/ChangeLog: * resolve.cc: Do not apply default initialization to a derived-type function result if the resolved function is use-associated. gcc/testsuite/ChangeLog: * gfortran.dg/derived_result_4.f90: New test.
-rw-r--r--gcc/fortran/resolve.cc3
-rw-r--r--gcc/testsuite/gfortran.dg/derived_result_4.f9038
2 files changed, 40 insertions, 1 deletions
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index cf9318f..cb36589 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -17946,7 +17946,8 @@ skip_interfaces:
/* Mark the result symbol to be referenced, when it has allocatable
components. */
sym->result->attr.referenced = 1;
- else if (a->function && !a->pointer && !a->allocatable && sym->result)
+ else if (a->function && !a->pointer && !a->allocatable && !a->use_assoc
+ && sym->result)
/* Default initialization for function results. */
apply_default_init (sym->result);
}
diff --git a/gcc/testsuite/gfortran.dg/derived_result_4.f90 b/gcc/testsuite/gfortran.dg/derived_result_4.f90
new file mode 100644
index 0000000..12ab190
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_result_4.f90
@@ -0,0 +1,38 @@
+! { dg-do compile }
+! { dg-additional-options "-Wall -Wno-return-type -Wno-unused-variable" }
+!
+! PR fortran/118796 - bogus recursion with DT default initialization
+
+module m1
+ implicit none
+
+ type :: t1
+ type(integer) :: f1 = 0
+ end type t1
+
+ TYPE :: c1
+ contains
+ procedure, public :: z
+ END TYPE c1
+
+contains
+ ! type-bound procedure z has a default initialization
+ function z( this )
+ type(t1) :: z
+ class(c1), intent(in) :: this
+ end function z
+end module m1
+
+module m2
+ use m1, only : c1
+contains
+ function z() result(field)
+ end function z
+end module m2
+
+module m3
+ use m1, only : c1
+contains
+ function z()
+ end function z
+end module m3