OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/56385 ([OOP] ICE with allocatable function result in a procedure-pointer component) 

2013-02-22  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/56385
	* trans-array.c (structure_alloc_comps): Handle procedure-pointer
	components with allocatable result.

2013-02-22  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/56385
	* gfortran.dg/proc_ptr_comp_37.f90: New.

From-SVN: r196227
This commit is contained in:
Janus Weil 2013-02-22 20:48:11 +01:00
parent 86aa22c4d0
commit 4d9ea42dda
4 changed files with 40 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
2013-02-22 Janus Weil <janus@gcc.gnu.org>
PR fortran/56385
* trans-array.c (structure_alloc_comps): Handle procedure-pointer
components with allocatable result.
2013-02-17 Tobias Burnus <burnus@net-b.de>
Mikael Morin <mikael@gcc.gnu.org>

7
gcc/fortran/trans-array.c
View File

@ -7392,8 +7392,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
called_dealloc_with_status = false;
gfc_init_block (&tmpblock);
if (c->attr.allocatable
&& (c->attr.dimension || c->attr.codimension))
if (c->attr.allocatable && (c->attr.dimension || c->attr.codimension)
&& !c->attr.proc_pointer)
{
comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
decl, cdecl, NULL_TREE);
@ -7575,7 +7575,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
continue;
}
if (c->attr.allocatable && !cmp_has_alloc_comps)
if (c->attr.allocatable && !c->attr.proc_pointer
&& !cmp_has_alloc_comps)
{
rank = c->as ? c->as->rank : 0;
tmp = gfc_duplicate_allocatable (dcmp, comp, ctype, rank);

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2013-02-22 Janus Weil <janus@gcc.gnu.org>
PR fortran/56385
* gfortran.dg/proc_ptr_comp_37.f90: New.
2013-02-20 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE>
Backport from mainline:

25
gcc/testsuite/gfortran.dg/proc_ptr_comp_37.f90 Normal file
View File

@ -0,0 +1,25 @@
! { dg-do compile }
!
! PR 56385: [4.6/4.7/4.8 Regression] [OOP] ICE with allocatable function result in a procedure-pointer component
!
! Contributed by Vladimir Fuka <vladimir.fuka@gmail.com>
implicit none
type :: TGeometricShape
end type
type :: TVolumeSourceBody
class(TGeometricShape), allocatable :: GeometricShape
procedure(scalar_flux_interface), pointer :: get_scalar_flux
end type
abstract interface
function scalar_flux_interface(self) result(res)
import
real, allocatable :: res(:)
class(TVolumeSourceBody), intent(in) :: self
end function
end interface
end