https://gcc.gnu.org/bugzilla/show_bug.cgi?id=77525
Themos Tsikas changed:
What|Removed |Added
CC||themos.tsikas at gmail dot com
--- Comment #3 from Themos Tsikas ---
For the benefit of others which encounter this bug, a workaround is presented
below:
Module mdb_proc
Implicit None
Abstract Interface
Subroutine p(tx, r)
Real, Intent (In) :: tx(*)
Real, Intent (Out) :: r
End Subroutine
End Interface
Type mdb_proc_t
Character (32) :: cname
Integer :: mode = 0
Procedure (p), Pointer, Nopass :: f
End Type
Integer, Parameter :: nprocmax = 2
Type (mdb_proc_t), Target :: listproc(1:nprocmax)
End Module
Subroutine test(tx, r)
Use mdb_proc, Only: mdb_proc_t, listproc, p
Implicit None
Real, Intent (In) :: tx(*)
Real, Intent (Out) :: r
Type (mdb_proc_t), Pointer :: my_proc
my_proc => listproc(1)
! Call my_proc%f(tx,r)
Call workaround(pp=my_proc%f, tx=tx, r=r)
Print '(EN12.3)', r
Contains
Subroutine workaround(pp, tx, r)
Procedure (p) :: pp
Real, Intent (In) :: tx(*)
Real, Intent (Out) :: r
Call pp(tx, r)
End Subroutine
End Subroutine
Program main
Use mdb_proc, Only:mdb_proc_t, listproc
Real, Allocatable :: z(:)
Integer :: nz
listproc(1) = mdb_proc_t('a', 1, p1)
Allocate (z(0))
nz = 0
Call test(z, r)
Deallocate (z)
Allocate (z(1))
z = 42.
nz = 1
Call test(z, r)
Contains
Subroutine p1(tx, r)
Real, Intent (In) :: tx(*)
Real, Intent (Out) :: r
r = maxval(tx(1:nz))
End Subroutine
End Program
