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

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

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

--- Comment #4 from Paul Thomas <pault at gcc dot gnu.org> ---
Created attachment 56775
  --> https://gcc.gnu.org/bugzilla/attachment.cgi?id=56775&action=edit
Deadend fix for this PR

I got as far as I could with this fix up method. The testcase below fails and
so I am going to set aside this approach and tackle what I should have done in
the first place: two step parsing of contained procedures.

The patch contains a fix for class array function selectors that do not work,
even if the selector function is parsed first. I will make a new PR for this
and will break out the patch for it and post it to the list.

Paul

module m
  implicit none
  type t
    integer :: i = 0
  end type t
  integer :: i = 0
  type(t), parameter :: test_array (2) = [t(42),t(84)], &
                        test_scalar = t(99)
end module m
module class_selectors
  use m
  implicit none
  private
  public foo2
contains

  subroutine foo2()
    associate (var1 => bar3())
      if (any (var1%i .ne. test_array%i)) stop 8
      if (var1(2)%i .ne. test_array(2)%i) stop 9
!      associate (var3 => var1%i)                  ! This still fails
!         print *, "yipee"
!      end associate
      select type (x => var1)
        type is (t)
          if (any (x%i .ne. test_array%i)) stop 10
          if (x(1)%i .ne. test_array(1)%i) stop 11
        class default
          stop 12
      end select
    end associate

    select type (y => bar3 ())
      type is (t)
        print *, "yes, size of 'y' is ", size(y), y(1)
      class default
        print *, "no"
    end select
  end subroutine foo2

! Since these functions are parsed after 'foo', the symbols were not available
! for the selectors and the fixup, tested here, was necessary.

  function bar3() result(res)
    class(t), allocatable :: res(:)
    allocate (res, source = test_array)
  end
end module class_selectors

  use class_selectors
  call foo2
end

Reply via email to