I found a strange bug with the intel fortran compiler:
Maybe someone has an idea for this here.
Cheers, Sebastian
I found a strange bug with the intel fortran compiler:
Maybe someone has an idea for this here.
Cheers, Sebastian
I don’t think this is a compiler bug. operator(-)
is bind to type(vector)
but not type(vector_parameter)
and thus the compiler complains This binary operation is invalid for this data type.
You either make type(vector)
an abstract type and define some abstract interfaces or move all type-bound procedures to the extended type.
Besides, I find using interface
and type-bound procedures in the same module a bit confusing. To initialize the type using type-bound procedure you could use generic :: assignment(=) => init_sub
. As for interfaces vs type-bound procedures, here is a good discussion: Drawback of type-bound procedures (vs. interfaces)? - Help - Fortran Discourse (fortran-lang.discourse.group).
Thanks for your thoughts. But why does it work then, if I comment out the unary operator (“neg”)?
Hi Sebastian, welcome to this forum.
As @han190 pointed out, the issue in your original code the operator(-)
is bound to the type(vector)
. I suggest to read carefully the link he shared.
As for your problem, I don’t know what you actually want to achieve, but from what I could infer, you might find interesting this variant, which removes entirely the extending type(vector_parameter)
:
module mo_vec
type, public :: vector
real :: x, y
end type vector
interface operator(-)
module procedure diff
module procedure neg
end interface
interface vector
procedure init_vec
end interface vector
contains
! NOTE: this is what the compiler already provides you in any case.
! WHICH IS THE ONLY CONSTRUCTOR YOU CAN CALL IN A CONSTANT EXPRESSION
elemental pure type(vector) function vector_as_comp(x, y)
real, intent(in) :: x, y
vector_as_comp%x = x
vector_as_comp%y = y
end function vector_as_comp
! Your custom defined vector constructor
elemental pure type(vector) function init_vec(x, y, factor)
real, intent(in) :: x, y, factor
real :: x_, y_
x_ = x * factor
y_ = y * factor
init_vec = vector(x_, y_)
end function init_vec
pure type(vector) function diff(this, that)
class(vector), intent(in) :: this, that
diff = vector(this%x-that%x, this%y-that%y)
end function diff
pure type(vector) function neg(this)
class(vector), intent(in) :: this
neg = vector(-this%x, -this%y)
end function neg
end module mo_vec
program vec_test
use mo_vec
implicit none
type(vector), parameter :: vec_x = vector(1., 0.)
type(vector), parameter :: vec_y = vector(0., 1.)
print *, vec_x - vec_y
print *, vec_x - -vec_y
print *, vector(1., 2., 5.)
end program vec_test
Basically, you simply make use of the default constructor that the compiler “writes” for you. Which in Fortran is the only one constructor you can use when default constructing a variable.
PS: of course, you could entirely remove the procedure vector_as_comp
, it is there just as a matter of example.
Because when you comment out neg
, essentially you are just using the inherited method diff
. “A Fortran extended type inherits all of the type parameters, components and nonoverridden, nonfinal procedure bindings from its parent type” (Extensible derived types (Fortran 2003) - IBM Documentation). But when you do generic :: operator(-) => diff, neg
, the generic binding is not inherited and you will have to define your operator(-)
for the extended type as well. I suggest you read @FortranFan’s answer in Custom operators in extended type - Help - Fortran Discourse (fortran-lang.discourse.group).
Thanks for all your input. I still think, there is something wrong.
factor
argument optional in init_vec
. Why is that? I guess this is because, the signature is then indistinguishable from the native interface. If it doesn’t work with optional, I need the extended type for parameters.class(vector)
there. And if I keep one (either diff
or neg
) it works, but with both it doesn’t. And it only happens with the intel compiler (gfortran and nag don’t complain). I don’t find anything in the standard stating a behavior like this. And the statement for initializing a type with assignment(=)
is wrong IMHO.Others also second the bug assumption in the intel fortran compiler: Re: Fortran Compiler Bug: overloading binary and unary operator(-) and use with extended types - Intel Community
Here is a discussion about custom constructors in constant expressions with intel fortran:
Sebastian, could you please explain why you seem to want to have the factor optional
?
That’s why in my first answer I said “what you actually want to achieve”.
In any case, you could not call your custom init_vec
vector constructor for initialising parameter
entities.
But, I might miss something.
It could actually be a compiler bug as mentioned in the comments of the link you report here. I slightly modified your implementation, which generated an ICE.
This, which I think should reproduce what you want to achieve, compiles and runs correctly:
module mod
implicit none
type :: base1
integer :: i
contains
generic :: proc => baseProc1_
procedure, pass(this) :: baseProc1_
end type
type, extends(base1) :: ext1
end type
type :: base2
integer :: i
contains
generic :: proc => baseProc2_, anotherProc_
procedure, pass(this) :: baseProc2_, anotherProc_
end type
type, extends(base2) :: ext2
end type
contains
function baseProc1_(this)
class(base1), intent(in) :: this
type(base1) :: baseProc1_
print *, ' This is base proc 1 ! '
baseProc1_ = base1(this%i + 1)
end function
function baseProc2_(this)
class(base2), intent(in) :: this
type(base2) :: baseProc2_
print *, ' This is base proc 2 ! '
baseProc2_ = base2(-this%i)
end function
function anotherProc_(this, i)
class(base2), intent(in) :: this
type(base2) :: anotherProc_
integer, intent(in) :: i
print *, ' This is another proc for base 2 ! '
anotherProc_ = base2(this%i + i)
end function
end module
program prog
use mod
implicit none
type(ext1), parameter :: e1 = ext1(1)
type(ext2), parameter :: e2 = ext2(5)
print *, e1%proc()
print *, e2%proc()
print *, e2%proc(5)
end program
As for your example, this is another proposition that works. But still, by also reading the other thread, it might not suit what you actually need.
module mo_vec
type, public :: vector
real :: x, y
end type vector
interface operator(-)
module procedure negVec_
module procedure diffVec_
module procedure negVecP_
module procedure diffVecP_
end interface
! interface assignment(=)
! module procedure assignVec_
! module procedure assignVecP_
! end interface
interface vector
procedure init_vec
end interface vector
type, public, extends(vector) :: vector_parameter
end type
contains
! Your custom defined vector constructor
elemental pure type(vector) function init_vec(x, y, factor)
real, intent(in) :: x, y, factor
init_vec = vector(x * factor, y * factor)
end function init_vec
pure function diffVec_(this, that)
type(vector), intent(in) :: this, that
type(vector) :: diffVec_
diffVec_ = vector(this%x-that%x, this%y-that%y)
end function diffVec_
pure function diffVecP_(this, that)
type(vector_parameter), intent(in) :: this, that
type(vector_parameter) :: diffVecP_
diffVecP_ = vector_parameter(this%x-that%x, this%y-that%y)
end function diffVecP_
pure function negVec_(this)
type(vector), intent(in) :: this
type(vector) :: negVec_
negVec_ = vector(-this%x, -this%y)
end function negVec_
pure function negVecP_(this)
type(vector_parameter), intent(in) :: this
type(vector_parameter) :: negVecP_
negVecP_ = vector_parameter(-this%x, -this%y)
end function negVecP_
end module mo_vec
program vec_test
use mo_vec
implicit none
type(vector_parameter), parameter :: vec_x = vector_parameter(1., 0.)
type(vector_parameter), parameter :: vec_y = vector_parameter(0., 1.)
print *, vec_x - vec_y
print *, vec_x - -vec_y
print *, vector(1., 2., 5.)
end program vec_test
Thanks for this suggestion. Indeed replacing class
with type
can solve the inter-compiler compatibility (nag, gfortran) but will prevent proper extending the type (which I don’t need, so I am fine with it).
I found also hacky solution by making the native constructor distinguishable from my custom one. Then I don’t need the extended type for parameters and I don’t run into the described bug. But I agree with the comments that this could be confusing:
For the record, this is the boiled down bug (actually two bugs) for the Intel-Fortran compilers:
module mo_vec
type :: typ1
real :: x
contains
procedure :: diff, neg
generic :: operator(-) => diff, neg
end type typ1
! extended type
type, extends(typ1) :: typ2
end type typ2
contains
pure type(typ1) function diff(this, that)
class(typ1), intent(in) :: this, that
diff = typ1(this%x-that%x)
end function diff
pure type(typ1) function neg(this)
class(typ1), intent(in) :: this
neg = typ1(-this%x)
end function neg
end module mo_vec
program vec_test
use mo_vec, only: typ2
type(typ2) :: var1 = typ2(1.), var2 = typ2(2.)
print *, -var2 ! error #5633: **Internal compiler error
print *, var1-var2 ! error #6355: This binary operation is invalid for this data type.
end program vec_test
I’ll test this on the pre-build for 2023.2 and our nightly builds and report back.
ron
The var1-var2 case is written up, bug ID is CMPLRLLVM-48074
The case -var2 does not get ICE for me with either the 2023.0.0 or the 2023.1.0 version of ifx. Not sure what version you have that shows the ICE but there is no ICE in recent ifx versions.
I forgot to mention that this bug was also in LFortran, I reported it on May 24: Overloading binary and unary operators · Issue #1697 · lfortran/lfortran · GitHub and it got fixed on May 30. The code in Intel Fortran Compiler Bug: overloading binary and unary operator(-) and use with extended types - #10 by sebastian.mueller now prints:
$ lfortran a.f90
-2.00000000e+00
-1.00000000e+00
With the latest build available for Linux (2023.2.0, versions reported by ifort/ifx: 2021.10.0/2023.2.0) it behaves somewhat strangely. It does not report ICE on line
print *, -var2
on original version, only error #6355: This binary operation is invalid for this data type. on the next line, #26 print *, var1-var2
.
But when I comment out the latter line, both ifort and ifx crash badly with ICE reported, apparently on line #25.