Sorry, yes; proc_ptr_48.f90
! { dg-do run }
!
! Checks the fix for PR68196, comment #8
!
! Contributed by Damian Rouson <dam...@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
On 18 December 2015 at 04:56, Steve Kargl
<s...@troutmask.apl.washington.edu> wrote:
> On Thu, Dec 17, 2015 at 11:12:17PM +0100, Paul Richard Thomas wrote:
>>
>> Some problems have come up that are not dissimilar to the original
>> bug, involving infinite recursion with procedure components, with the
>> same type as the containing type. The fix is verging on the trivial.
>> However, given that I found two further bugs in fixing the one
>> reported, I worry that there are more lurking nearby.
>>
>> Bootstraps and regtests on x86_64 - OK for trunk and, in a couple of
>> weeks 5 and 4.9 branches?
>>
>
> OK.
>
> Do you have a testcase that should also be committed?
>
> --
> Steve
--
Outside of a dog, a book is a man's best friend. Inside of a dog it's
too dark to read.
Groucho Marx
