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.

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index bf1aa704888fcd55bba8e05e64c4cd1df743ba39..d09aef0a899cff24986d4786c3e155004da9f4a0 100644 (file)
--- 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 2af089e84e8d12cf43d6ad8863df9aba74ed86f5..d0751f3d3eba2524d33878be7e3dda53be0431b5 100644 (file)
--- 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 0753e33d535d8b15acade78e949212e2c3ad83b7..8202d783621c5425cac147ef0988dbcd5929cfdf 100644 (file)
--- 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 4a55d73b245e7cf4f5ffd8bb5be0573cd836f61c..9ff38e3fb7c5fe6bba9c80f30b936c698e721eec 100644 (file)
--- 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 fd2db7439fe0268e42d290b85662df80ba70b164..36c1245ccdd8ea495a1ba5657ead04d8928b51d0 100644 (file)
--- 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 bdfa47b1df5305d287ccfc0cb1d81aa7f4bf0715..406e031456ffa3b39b4b36397a04f460a63e4687 100644 (file)
--- 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 (file)
index 0000000..1ba4d19
--- /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