Intel Fortran Compiler Bug: overloading binary and unary operator(-) and use with extended types

I found a strange bug with the intel fortran compiler:

Maybe someone has an idea for this here.

Cheers, Sebastian

1 Like

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.

  1. @mEm your example breaks, when I make the 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.
  2. @han190 I don’t get this. I don’t want a custom operator in the extended type, I want the same. That is why I use 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
1 Like

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.