1! { dg-do run }
2!
3! Checks the fix for PR68196, comment #8
4!
5! Contributed by Damian Rouson  <damian@sourceryinstitute.org>
6!
7  type  Bug                                  ! Failed at trans--array.c:8269
8    real, allocatable :: scalar
9    procedure(boogInterface),pointer :: boog
10  end type
11  interface
12    function boogInterface(A) result(C)
13      import Bug
14      class(Bug) A
15      type(Bug)  C
16    end function
17  end interface
18
19  real, parameter :: ninetynine = 99.0
20  real, parameter :: onenineeight = 198.0
21
22  type(bug) :: actual, res
23
24  actual%scalar = ninetynine
25  actual%boog => boogImplementation
26
27  res = actual%boog ()                       ! Failed on bug in expr.c:3933
28  if (res%scalar .ne. onenineeight) STOP 1
29
30! Make sure that the procedure pointer is assigned correctly
31  if (actual%scalar .ne. ninetynine) STOP 2
32  actual = res%boog ()
33  if (actual%scalar .ne. onenineeight) STOP 3
34
35! Deallocate so that we can use valgrind to check for memory leaks
36  deallocate (res%scalar, actual%scalar)
37
38contains
39    function boogImplementation(A) result(C) ! Failed at trans--array.c:8078
40      class(Bug) A
41      type(Bug)  C
42      select type (A)
43        type is (bug)
44          C = A
45          C%scalar = onenineeight
46        class default
47          STOP 4
48      end select
49    end function
50end
51