Apologies again for the second ifort-related topic today (again trying to build fpm
with the Intel compiler). I have an issue with ifort 2021.7 and ifx 2022.1 reproduced by this example program. I have an extended class, where one of the procedures in a generic interface is overridden. Ifort does not seem to recognize that, and the base procedure is always called:
module b
type :: base
contains
procedure, private :: ba
procedure, private :: bb
generic :: ab => ba,bb
end type
contains
subroutine ba(self,one)
class(base), intent(inout) :: self
integer, intent(in) :: one
print *, 'BA'
end subroutine ba
subroutine bb(self,many)
class(base), intent(inout) :: self
integer, intent(in) :: many(:)
print *, 'BB'
end subroutine bb
end module b
module e
use b
type, extends(base) :: extended
contains
procedure, private :: bb => bb_extended
end type
contains
subroutine bb_extended(self,many)
class(extended), intent(inout) :: self
integer, intent(in) :: many(:)
print *, 'BB_EXT'
end subroutine bb_extended
end module e
program test
use e
type(extended) :: my
call my%ab([1,2,3,4,5])
end program test
produces output:
BB
instead of BB_EXT
. Curiously, if both base and extended class are into the same module, the correct output is produced (see here).
Can I ask any of the Intel Fortran gurus directions? Should I file this issue to the Intel support? Thank you in advance. The issue can be tested on godbolt.