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