Mercurial > hg > CbC > CbC_gcc
view gcc/testsuite/gfortran.dg/proc_ptr_48.f90 @ 152:2b5abeee2509
update gcc11
author | anatofuz |
---|---|
date | Mon, 25 May 2020 07:50:57 +0900 |
parents | 84e7813d76e9 |
children |
line wrap: on
line source
! { 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) STOP 1 ! Make sure that the procedure pointer is assigned correctly if (actual%scalar .ne. ninetynine) STOP 2 actual = res%boog () if (actual%scalar .ne. onenineeight) STOP 3 ! 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 STOP 4 end select end function end