https://gcc.gnu.org/bugzilla/show_bug.cgi?id=68196

--- Comment #9 from Paul Thomas <pault at gcc dot gnu.org> ---
Created attachment 37062
  --> https://gcc.gnu.org/bugzilla/attachment.cgi?id=37062&action=edit
Patch for the new bug

This patch bootstraps and regtests on FC21/x86_64

Developing the testcase uncovered two more bugs associated with infinite
recursion. I am astonished that these had not been reported much earlier.

The testcase below works fine, although, to avoid moral turpitude accusations,
I guess that some of the symbol/component names will have to be changed :-)

Paul

  type  Bug ! Failed at trans--array.c:8269
    real, allocatable :: scalar
    procedure(buggerInterface),pointer :: bugger
  end type
  interface
    function buggerInterface(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%bugger => buggerImplementation

  res = actual%bugger ()  ! 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%bugger ()
  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 buggerImplementation(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

Reply via email to