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

Paul Thomas <pault at gcc dot gnu.org> changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
                 CC|                            |pault at gcc dot gnu.org
           Assignee|unassigned at gcc dot gnu.org      |pault at gcc dot gnu.org

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

Dear Damian,

Thanks for this one! Dominique was quite right as to where the infinite
recursion occurs. Once fixed, however, the same thing happens again in
trans-types.c!

The attached patch fixes both and is just now regtesting.

The testcase is:
! { dg-do run }
! Tests the fix for PR68196
!
! Contributed by Damian Rouson  <dam...@sourceryinstitute.org>
!
  type AA
    integer :: i
    procedure(foo), pointer :: funct
  end type
  class(AA), allocatable :: my_AA
  type(AA) :: res

  allocate (my_AA, source = AA (1, foo))

  res = my_AA%funct ()

  if (res%i .ne. 3) call abort
  if (.not.associated (res%funct)) call abort
  if (my_AA%i .ne. 4) call abort
  if (associated (my_AA%funct)) call abort

contains
  function foo(A)
    class(AA), allocatable :: A
    type(AA) foo

    if (.not.allocated (A)) then
      allocate (A, source = AA (2, foo))
    endif

    select type (A)
      type is (AA)
        foo = AA (3, foo)
        A = AA (4, NULL ())
    end select
  end function
end

Cheers

Paul

Reply via email to