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

re PR fortran/68196 (ICE on function result with procedure pointer component)

Browse Source 
2015-12-18  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/68196
	*expr.c (gfc_has_default_initializer): Prevent infinite recursion
	through this function for procedure pointer components.
	* trans-array.c (structure_alloc_comps): Ditto twice.


2015-12-18  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/68196
	* gfortran.dg/proc_ptr_48.f90: New test.

From-SVN: r231807
This commit is contained in:
Paul Thomas 2015-12-18 09:34:13 +00:00
parent 6638efce56
commit 3324776285
5 changed files with 67 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View File

@ -1,3 +1,10 @@
2015-12-18 Paul Thomas <pault@gcc.gnu.org>
PR fortran/68196
*expr.c (gfc_has_default_initializer): Prevent infinite recursion
through this function for procedure pointer components.
* trans-array.c (structure_alloc_comps): Ditto twice.
2015-12-15 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>
* resolve.c (resolve_critical): Committing symbols of

2
gcc/fortran/expr.c
View File

@ -3930,7 +3930,7 @@ gfc_has_default_initializer (gfc_symbol *der)
for (c = der->components; c; c = c->next)
if (c->ts.type == BT_DERIVED)
{
if (!c->attr.pointer
if (!c->attr.pointer && !c->attr.proc_pointer
&& gfc_has_default_initializer (c->ts.u.derived))
return true;
if (c->attr.pointer && c->initializer)

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

@ -8074,7 +8074,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
}
if (cmp_has_alloc_comps
&& !c->attr.pointer
&& !c->attr.pointer && !c->attr.proc_pointer
&& !called_dealloc_with_status)
{
/* Do not deallocate the components of ultimate pointer
@ -8264,7 +8264,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
components that are really allocated, the deep copy code has to
be generated first and then added to the if-block in
gfc_duplicate_allocatable (). */
if (cmp_has_alloc_comps)
if (cmp_has_alloc_comps
&& !c->attr.proc_pointer)
{
rank = c->as ? c->as->rank : 0;
tmp = fold_convert (TREE_TYPE (dcmp), comp);

7
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2015-12-18 Paul Thomas <pault@gcc.gnu.org>
PR fortran/68196
* gfortran.dg/proc_ptr_48.f90: New test.
2015-12-18 Andreas Krebbel <krebbel@linux.vnet.ibm.com>
* gcc.target/s390/hotpatch-8.c: Add -Wno-deprecated to options.
@ -16,7 +21,7 @@
2015-12-17 Nathan Sidwell <nathan@acm.org>
* gcc.dg/ipa/ipa-icf-merge-1.c: New.
2015-12-17 David Malcolm <dmalcolm@redhat.com>
* gcc.dg/diagnostic-range-bad-return.c: New test case.

50
gcc/testsuite/gfortran.dg/proc_ptr_48.f90 Normal file
View File

@ -0,0 +1,50 @@
! { dg-do run }
!
! Checks the fix for PR68196, comment #8
!
! Contributed by Damian Rouson <damian@sourceryinstitute.org>
!
type Bug ! Failed at trans--array.c:8269
real, allocatable :: scalar
procedure(boogInterface),pointer :: boog
end type
interface
function boogInterface(A) result(C)
import Bug
class(Bug) A
type(Bug) C
end function
end interface
real, parameter :: ninetynine = 99.0
real, parameter :: onenineeight = 198.0
type(bug) :: actual, res
actual%scalar = ninetynine
actual%boog => boogImplementation
res = actual%boog () ! Failed on bug in expr.c:3933
if (res%scalar .ne. onenineeight) call abort
! Make sure that the procedure pointer is assigned correctly
if (actual%scalar .ne. ninetynine) call abort
actual = res%boog ()
if (actual%scalar .ne. onenineeight) call abort
! Deallocate so that we can use valgrind to check for memory leaks
deallocate (res%scalar, actual%scalar)
contains
function boogImplementation(A) result(C) ! Failed at trans--array.c:8078
class(Bug) A
type(Bug) C
select type (A)
type is (bug)
C = A
C%scalar = onenineeight
class default
call abort
end select
end function
end