Dear all,
the attached patch fixes missing default-initialization of function
results of derived type that happens under some conditions, see PR.
The logic when default initialization is to be applied is rather
contorted, and reversing the order of two cases fixed the issue.
Regtesting revealed a few bogus warnings in the testsuite,
and some counts of tree-dump scans needed adjustment.
Regtested on x86_64-pc-linux-gnu. OK for mainline?
The PR marks the issue as a regression since gcc-6, which I cannot
test. I therefore feel that this fix should be backported to
15-branch. Going back further would need backporting of other
patches (e.g. to pr98454), so if someone pushes me, I can try.
Let me know what you think.
Cheers,
Harald
From 8a1f2ae8c0ea3a92d9b20f0e678b56583ca4a849 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@gmx.de>
Date: Thu, 15 May 2025 21:07:07 +0200
Subject: [PATCH] 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.
---
gcc/fortran/resolve.cc | 8 +-
.../gfortran.dg/alloc_comp_auto_array_3.f90 | 4 +-
.../gfortran.dg/alloc_comp_class_3.f03 | 3 +-
.../gfortran.dg/alloc_comp_class_4.f03 | 5 +-
.../gfortran.dg/allocate_with_source_14.f03 | 2 +-
.../derived_constructor_comps_6.f90 | 2 +-
.../gfortran.dg/derived_result_5.f90 | 123 ++++++++++++++++++
7 files changed, 134 insertions(+), 13 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/derived_result_5.f90
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index bf1aa704888..d09aef0a899 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -18059,16 +18059,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 && !a->use_assoc
- && 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 2af089e84e8..d0751f3d3eb 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 0753e33d535..8202d783621 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 4a55d73b245..9ff38e3fb7c 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 fd2db7439fe..36c1245ccdd 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 bdfa47b1df5..406e031456f 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 00000000000..1ba4d19dc44
--- /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
--
2.43.0
