From mboxrd@z Thu Jan  1 00:00:00 1970
Return-Path: <gcc-bugzilla@gcc.gnu.org>
Received: by sourceware.org (Postfix, from userid 48)
 id A70C8385DC1A; Tue, 26 Jan 2021 15:17:22 +0000 (GMT)
DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org A70C8385DC1A
From: "pault at gcc dot gnu.org" <gcc-bugzilla@gcc.gnu.org>
To: gcc-bugs@gcc.gnu.org
Subject: [Bug fortran/93924] [OOP] ICE with procedure pointer
Date: Tue, 26 Jan 2021 15:17:22 +0000
X-Bugzilla-Reason: CC
X-Bugzilla-Type: changed
X-Bugzilla-Watch-Reason: None
X-Bugzilla-Product: gcc
X-Bugzilla-Component: fortran
X-Bugzilla-Version: 9.1.1
X-Bugzilla-Keywords: ice-on-valid-code
X-Bugzilla-Severity: normal
X-Bugzilla-Who: pault at gcc dot gnu.org
X-Bugzilla-Status: NEW
X-Bugzilla-Resolution: 
X-Bugzilla-Priority: P3
X-Bugzilla-Assigned-To: unassigned at gcc dot gnu.org
X-Bugzilla-Target-Milestone: ---
X-Bugzilla-Flags: 
X-Bugzilla-Changed-Fields: 
Message-ID: <bug-93924-4-P0f6UlPmtQ@http.gcc.gnu.org/bugzilla/>
In-Reply-To: <bug-93924-4@http.gcc.gnu.org/bugzilla/>
References: <bug-93924-4@http.gcc.gnu.org/bugzilla/>
Content-Type: text/plain; charset="UTF-8"
Content-Transfer-Encoding: quoted-printable
X-Bugzilla-URL: http://gcc.gnu.org/bugzilla/
Auto-Submitted: auto-generated
MIME-Version: 1.0
X-BeenThere: gcc-bugs@gcc.gnu.org
X-Mailman-Version: 2.1.29
Precedence: list
List-Id: Gcc-bugs mailing list <gcc-bugs.gcc.gnu.org>
List-Unsubscribe: <https://gcc.gnu.org/mailman/options/gcc-bugs>,
 <mailto:gcc-bugs-request@gcc.gnu.org?subject=unsubscribe>
List-Archive: <https://gcc.gnu.org/pipermail/gcc-bugs/>
List-Post: <mailto:gcc-bugs@gcc.gnu.org>
List-Help: <mailto:gcc-bugs-request@gcc.gnu.org?subject=help>
List-Subscribe: <https://gcc.gnu.org/mailman/listinfo/gcc-bugs>,
 <mailto:gcc-bugs-request@gcc.gnu.org?subject=subscribe>
X-List-Received-Date: Tue, 26 Jan 2021 15:17:22 -0000

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

--- 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
>=20
> The attached patch has a fragment of my finalize on assignment patch in t=
he
> second chunk. The changes are small and few so could be applied manually.
>=20
> Whatever is the legality or otherwise, this fixes all versions of the
> problem and regtests OK.
>=20
> Please do what you will with this. If it is still open in a few weeks tim=
e,
> I will take it. At the present, I have too many open PRs.
>=20
> 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 =3D x   ! One way of overcoming dangling target bus=
iness
         y =3D> integer_target
      class default
         y =3D> 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 =3D 0                   ! Get rid of 'y' undefined warning
      p =3D> f(x)
      select type (p)
      type is (integer)
         y =3D p
      end select
   end function apply

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

end module cs


program classStar_map

use cs
implicit none

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

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

end program classStar_map=