(root)/
gcc-13.2.0/
gcc/
testsuite/
gfortran.dg/
proc_ptr_48.f90
! { 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