https://gcc.gnu.org/g:0100ea2b4eb1c83972e0db07503a7cfe8a38932e
commit r14-11805-g0100ea2b4eb1c83972e0db07503a7cfe8a38932e
Author: Harald Anlauf <anl...@gmx.de>
Date: Thu May 15 21:07:07 2025 +0200
Fortran: default-initialization and functions returning derived type
[PR85750]
Functions with non-pointer, non-allocatable result and of derived type did
not always get initialized although the type had default-initialization,
and a derived type component had the allocatable or pointer attribute.
Rearrange the logic when to apply default-initialization.
PR fortran/85750
gcc/fortran/ChangeLog:
* resolve.cc (resolve_symbol): Reorder conditions when to apply
default-initializers.
gcc/testsuite/ChangeLog:
* gfortran.dg/alloc_comp_auto_array_3.f90: Adjust scan counts.
* gfortran.dg/alloc_comp_class_3.f03: Remove bogus warnings.
* gfortran.dg/alloc_comp_class_4.f03: Likewise.
* gfortran.dg/allocate_with_source_14.f03: Adjust scan count.
* gfortran.dg/derived_constructor_comps_6.f90: Likewise.
* gfortran.dg/derived_result_5.f90: New test.
(cherry picked from commit d31ab498b12ebbe4f50acb2aa240ff92c73f310c)
Diff:
---
gcc/fortran/resolve.cc | 7 +-
.../gfortran.dg/alloc_comp_auto_array_3.f90 | 4 +-
gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 | 3 +-
gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 | 5 +-
.../gfortran.dg/allocate_with_source_14.f03 | 2 +-
.../gfortran.dg/derived_constructor_comps_6.f90 | 2 +-
gcc/testsuite/gfortran.dg/derived_result_5.f90 | 123 +++++++++++++++++++++
7 files changed, 134 insertions(+), 12 deletions(-)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 4d8484a36f12..10a9e58b287a 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -17134,15 +17134,16 @@ skip_interfaces:
|| (a->dummy && !a->pointer && a->intent == INTENT_OUT
&& sym->ns->proc_name->attr.if_source != IFSRC_IFBODY))
apply_default_init (sym);
+ else if (a->function && !a->pointer && !a->allocatable && !a->use_assoc
+ && sym->result)
+ /* Default initialization for function results. */
+ apply_default_init (sym->result);
else if (a->function && sym->result && a->access != ACCESS_PRIVATE
&& (sym->ts.u.derived->attr.alloc_comp
|| sym->ts.u.derived->attr.pointer_comp))
/* 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)
- /* Default initialization for function results. */
- apply_default_init (sym->result);
}
if (sym->ts.type == BT_CLASS && sym->ns == gfc_current_ns
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_3.f90
b/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_3.f90
index 2af089e84e8d..d0751f3d3eba 100644
--- a/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_3.f90
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_3.f90
@@ -25,6 +25,6 @@ contains
allocate (array(1)%bigarr)
end function
end
-! { dg-final { scan-tree-dump-times "builtin_malloc" 3 "original" } }
+! { dg-final { scan-tree-dump-times "builtin_malloc" 4 "original" } }
! { dg-final { scan-tree-dump-times "builtin_free" 3 "original" } }
-! { dg-final { scan-tree-dump-times "while \\(1\\)" 4 "original" } }
+! { dg-final { scan-tree-dump-times "while \\(1\\)" 5 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03
b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03
index 0753e33d535d..8202d783621c 100644
--- a/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03
@@ -45,11 +45,10 @@ contains
type(c), value :: d
end subroutine
- type(c) function c_init() ! { dg-warning "not set" }
+ type(c) function c_init()
end function
subroutine sub(d)
type(u), value :: d
end subroutine
end program test_pr58586
-
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03
b/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03
index 4a55d73b245e..9ff38e3fb7c5 100644
--- a/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03
@@ -51,14 +51,14 @@ contains
type(t), value :: d
end subroutine
- type(c) function c_init() ! { dg-warning "not set" }
+ type(c) function c_init()
end function
class(c) function c_init2() ! { dg-warning "not set" }
allocatable :: c_init2
end function
- type(c) function d_init(this) ! { dg-warning "not set" }
+ type(c) function d_init(this)
class(d) :: this
end function
@@ -102,4 +102,3 @@ program test_pr58586
call add_c(oe%init())
deallocate(oe)
end program
-
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_14.f03
b/gcc/testsuite/gfortran.dg/allocate_with_source_14.f03
index fd2db7439fe0..36c1245ccdd8 100644
--- a/gcc/testsuite/gfortran.dg/allocate_with_source_14.f03
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_14.f03
@@ -210,5 +210,5 @@ program main
call v%free()
deallocate(av)
end program
-! { dg-final { scan-tree-dump-times "__builtin_malloc" 22 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_malloc" 23 "original" } }
! { dg-final { scan-tree-dump-times "__builtin_free" 29 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/derived_constructor_comps_6.f90
b/gcc/testsuite/gfortran.dg/derived_constructor_comps_6.f90
index bdfa47b1df53..406e031456ff 100644
--- a/gcc/testsuite/gfortran.dg/derived_constructor_comps_6.f90
+++ b/gcc/testsuite/gfortran.dg/derived_constructor_comps_6.f90
@@ -129,5 +129,5 @@ contains
prt_spec = name
end function new_prt_spec3
end program main
-! { dg-final { scan-tree-dump-times "__builtin_malloc" 15 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_malloc" 16 "original" } }
! { dg-final { scan-tree-dump-times "__builtin_free" 33 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/derived_result_5.f90
b/gcc/testsuite/gfortran.dg/derived_result_5.f90
new file mode 100644
index 000000000000..1ba4d19dc449
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_result_5.f90
@@ -0,0 +1,123 @@
+! { dg-do run }
+! { dg-additional-options "-O2 -Wreturn-type" }
+!
+! PR fortran/85750 - default-initialization and functions returning derived
type
+
+module bar
+ implicit none
+ type ilist
+ integer :: count = 42
+ integer, pointer :: ptr(:) => null()
+ end type ilist
+
+ type jlist
+ real, allocatable :: a(:)
+ integer :: count = 23
+ end type jlist
+
+contains
+
+ function make_list(i)
+ integer, intent(in) :: i
+ type(ilist), dimension(2) :: make_list
+ make_list(i)%count = i
+ end function make_list
+
+ function make_list_res(i) result(list)
+ integer, intent(in) :: i
+ type(ilist), dimension(2) :: list
+ list(i)%count = i
+ end function make_list_res
+
+ function make_jlist(i)
+ integer, intent(in) :: i
+ type(jlist), dimension(2) :: make_jlist
+ make_jlist(i)%count = i
+ end function make_jlist
+
+ function make_jlist_res(i) result(list)
+ integer, intent(in) :: i
+ type(jlist), dimension(2) :: list
+ list(i)%count = i
+ end function make_jlist_res
+
+ function empty_ilist()
+ type(ilist), dimension(2) :: empty_ilist
+ end function
+
+ function empty_jlist()
+ type(jlist), dimension(2) :: empty_jlist
+ end function
+
+ function empty_ilist_res() result (res)
+ type(ilist), dimension(2) :: res
+ end function
+
+ function empty_jlist_res() result (res)
+ type(jlist), dimension(2) :: res
+ end function
+
+end module bar
+
+program foo
+ use bar
+ implicit none
+ type(ilist) :: mylist(2) = ilist(count=-2)
+ type(jlist), allocatable :: yourlist(:)
+
+ mylist = ilist(count=-1)
+ if (any (mylist%count /= [-1,-1])) stop 1
+ mylist = empty_ilist()
+ if (any (mylist%count /= [42,42])) stop 2
+ mylist = ilist(count=-1)
+ mylist = empty_ilist_res()
+ if (any (mylist%count /= [42,42])) stop 3
+
+ allocate(yourlist(1:2))
+ if (any (yourlist%count /= [23,23])) stop 4
+ yourlist = jlist(count=-1)
+ if (any (yourlist%count /= [-1,-1])) stop 5
+ yourlist = empty_jlist()
+ if (any (yourlist%count /= [23,23])) stop 6
+ yourlist = jlist(count=-1)
+ yourlist = empty_jlist_res()
+ if (any (yourlist%count /= [23,23])) stop 7
+
+ mylist = make_list(1)
+ if (any (mylist%count /= [1,42])) stop 11
+ mylist = make_list(2)
+ if (any (mylist%count /= [42,2])) stop 12
+ mylist = (make_list(1))
+ if (any (mylist%count /= [1,42])) stop 13
+ mylist = [make_list(2)]
+ if (any (mylist%count /= [42,2])) stop 14
+
+ mylist = make_list_res(1)
+ if (any (mylist%count /= [1,42])) stop 21
+ mylist = make_list_res(2)
+ if (any (mylist%count /= [42,2])) stop 22
+ mylist = (make_list_res(1))
+ if (any (mylist%count /= [1,42])) stop 23
+ mylist = [make_list_res(2)]
+ if (any (mylist%count /= [42,2])) stop 24
+
+ yourlist = make_jlist(1)
+ if (any (yourlist%count /= [1,23])) stop 31
+ yourlist = make_jlist(2)
+ if (any (yourlist%count /= [23,2])) stop 32
+ yourlist = (make_jlist(1))
+ if (any (yourlist%count /= [1,23])) stop 33
+ yourlist = [make_jlist(2)]
+ if (any (yourlist%count /= [23,2])) stop 34
+
+ yourlist = make_jlist_res(1)
+ if (any (yourlist%count /= [1,23])) stop 41
+ yourlist = make_jlist_res(2)
+ if (any (yourlist%count /= [23,2])) stop 42
+ yourlist = (make_jlist_res(1))
+ if (any (yourlist%count /= [1,23])) stop 43
+ yourlist = [make_jlist_res(2)]
+ if (any (yourlist%count /= [23,2])) stop 44
+
+ deallocate (yourlist)
+end program foo
