[Bug fortran/93924] [OOP] ICE with procedure pointer

["pault at gcc dot gnu.org" <gcc-bugzilla@gcc.gnu.org>]

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

--- Comment #10 from Paul Thomas <pault at gcc dot gnu.org> ---
(In reply to Paul Thomas from comment #9)
> Created attachment 50057 [details]
> Patch that "fixes" all versions of the problem
> 
> The attached patch has a fragment of my finalize on assignment patch in the
> second chunk. The changes are small and few so could be applied manually.
> 
> Whatever is the legality or otherwise, this fixes all versions of the
> problem and regtests OK.
> 
> Please do what you will with this. If it is still open in a few weeks time,
> I will take it. At the present, I have too many open PRs.
> 
> Paul

Final remarks for the time being in comments below:

module cs

implicit none
private

public classStar_map_ifc
public apply, selector

integer, target :: integer_target

abstract interface
   function classStar_map_ifc(x) result(y)
      class(*), pointer            :: y
      class(*), target, intent(in) :: x
   end function classStar_map_ifc
end interface

contains

   function fun(x) result(y)
      class(*), pointer            :: y
      class(*), target, intent(in) :: x
      select type (x)
      type is (integer)
         integer_target = x   ! One way of overcoming dangling target business
         y => integer_target
      class default
         y => null()
      end select
   end function fun

   function apply(f, x) result(y)
      procedure(classStar_map_ifc) :: f
      integer, intent(in) :: x
      integer :: y
      class(*), pointer :: p
      y = 0                   ! Get rid of 'y' undefined warning
      p => f(x)
      select type (p)
      type is (integer)
         y = p
      end select
   end function apply

   function selector() result(f)
      procedure(classStar_map_ifc), pointer :: f
      f => fun
   end function selector

end module cs


program classStar_map

use cs
implicit none

integer :: x, y
procedure(classStar_map_ifc), pointer :: f

x = 123654
f => selector()               ! Fixed by second chunk in patch (suppresses
class assignment)
y = apply(f, x)               ! Fixed by first chunk in patch (passing
procedure)
print *, x, y

end program classStar_map