This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[patch, fortran] Don't initialize components of pointers to derived compounds (PR30793)
- From: Tobias Burnus <burnus at net-b dot de>
- To: "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Thu, 15 Feb 2007 18:23:27 +0100
- Subject: [patch, fortran] Don't initialize components of pointers to derived compounds (PR30793)
:ADDPATCH fortran:
If a function returns a variable of a derived type, its components are
initialized. (So far so good.) Unfortunally, gfortran also initializes
the components if the variable is only a pointer to a derived compound.
This yields to code like the following:
get_scalar_field_msh (fld)
{
struct mesh * __result_get_scalar_field_msh;
__result_get_scalar_field_msh->area.data = 0B; /* SIC! */
__result_get_scalar_field_msh->dist.data = 0B; /* SIC! */
__result_get_scalar_field_msh->interp.data = 0B; /* SIC! */
__result_get_scalar_field_msh = msh_ (&fld->base);
return __result_get_scalar_field_msh;
}
Solution: Well, simply don't initialize the components, if we have a
function which returns a pointer.
The following patch has been build and regression tested on
x86_64-unknown-linux-gnu.
Thanks for Salvatore Filippone for sending in the test case.
Ok for the trunk and after a week or so for 4.2 and 4.1?
Tobias
2007-02-15 Tobias Burnus <burnus@net-b.de>
PR fortran/30793
* trans-decl.c (): Do not initialize pointers to
derived components.
2007-02-15 Tobias Burnus <burnus@net-b.de>
PR fortran/30793
* gfortran.dg/func_derived_4.f90: New test.
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c (Revision 121986)
+++ gcc/fortran/trans-decl.c (Arbeitskopie)
@@ -3257,7 +3257,8 @@
if (result != NULL_TREE && sym->attr.function
&& sym->ts.type == BT_DERIVED
- && sym->ts.derived->attr.alloc_comp)
+ && sym->ts.derived->attr.alloc_comp
+ && !sym->attr.pointer)
{
rank = sym->as ? sym->as->rank : 0;
tmp2 = gfc_nullify_alloc_comp (sym->ts.derived, result, rank);
Index: gcc/testsuite/gfortran.dg/func_derived_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/func_derived_4.f90 (Revision 0)
+++ gcc/testsuite/gfortran.dg/func_derived_4.f90 (Revision 0)
@@ -0,0 +1,105 @@
+! { dg-do run }
+! PR fortran/30793
+! Check that pointer-returing functions
+! work derived types.
+!
+! Contributed by Salvatore Filippone.
+!
+module class_mesh
+ type mesh
+ real(kind(1.d0)), allocatable :: area(:)
+ end type mesh
+contains
+ subroutine create_mesh(msh)
+ type(mesh), intent(out) :: msh
+ allocate(msh%area(10))
+ return
+ end subroutine create_mesh
+end module class_mesh
+
+module class_field
+ use class_mesh
+ implicit none
+ private ! Default
+ public :: create_field, field
+ public :: msh_
+
+ type field
+ private
+ type(mesh), pointer :: msh => null()
+ integer :: isize(2)
+ end type field
+
+ interface msh_
+ module procedure msh_
+ end interface
+ interface create_field
+ module procedure create_field
+ end interface
+contains
+ subroutine create_field(fld,msh)
+ type(field), intent(out) :: fld
+ type(mesh), intent(in), target :: msh
+ fld%msh => msh
+ fld%isize = 1
+ end subroutine create_field
+
+ function msh_(fld)
+ type(mesh), pointer :: msh_
+ type(field), intent(in) :: fld
+ msh_ => fld%msh
+ end function msh_
+end module class_field
+
+module class_scalar_field
+ use class_field
+ implicit none
+ private
+ public :: create_field, scalar_field
+ public :: msh_
+
+ type scalar_field
+ private
+ type(field) :: base
+ real(kind(1.d0)), allocatable :: x(:)
+ real(kind(1.d0)), allocatable :: bx(:)
+ real(kind(1.d0)), allocatable :: x_old(:)
+ end type scalar_field
+
+ interface create_field
+ module procedure create_scalar_field
+ end interface
+ interface msh_
+ module procedure get_scalar_field_msh
+ end interface
+contains
+ subroutine create_scalar_field(fld,msh)
+ use class_mesh
+ type(scalar_field), intent(out) :: fld
+ type(mesh), intent(in), target :: msh
+ call create_field(fld%base,msh)
+ allocate(fld%x(10),fld%bx(20))
+ end subroutine create_scalar_field
+
+ function get_scalar_field_msh(fld)
+ use class_mesh
+ type(mesh), pointer :: get_scalar_field_msh
+ type(scalar_field), intent(in), target :: fld
+
+ get_scalar_field_msh => msh_(fld%base)
+ end function get_scalar_field_msh
+end module class_scalar_field
+
+program test_pnt
+ use class_mesh
+ use class_scalar_field
+ implicit none
+ type(mesh) :: msh
+ type(mesh), pointer :: mshp
+ type(scalar_field) :: quality
+ call create_mesh(msh)
+ call create_field(quality,msh)
+ mshp => msh_(quality)
+end program test_pnt
+
+! { dg-final { cleanup-modules "class_mesh class_scalar_field class_mesh" } }