Quantcast
Channel: Recent posts
Viewing all articles
Browse latest Browse all 415

Generic operators with ABSTRACT derived types such as (*) do not work as expected.

$
0
0

I think the following code is alright but Intel Fortran compiler 17.0 update 1 gives an unexpected error:

module parent_m

   implicit none

   private

   type, public, abstract :: parent_t
      private
   contains
      procedure(Iassign_parent), pass(lhs), deferred     :: assign_parent
      procedure(Ireal_times_parent), pass(rhs), deferred :: real_times_parent
      procedure(Iparent_op_parent), pass(lhs), deferred  :: parent_add_parent
      ! operators
      generic :: assignment(=) => assign_parent
      generic :: operator(+) => parent_add_parent
      generic :: operator(*) => real_times_parent
   end type parent_t

   abstract interface

      pure subroutine Iassign_parent(lhs, rhs)
      !< Operator `=`.
         import :: parent_t
         class(parent_t), intent(inout) :: lhs
         class(parent_t), intent(in)    :: rhs
      end subroutine Iassign_parent

      function Ireal_times_parent(lhs, rhs) result( res )
         !< Operator `real * type`.
         import :: parent_t
         real,            intent(in)  :: lhs
         class(parent_t), intent(in)  :: rhs
         class(parent_t), allocatable :: res
      end function Ireal_times_parent

      function Iparent_op_parent(lhs, rhs) result( res )
         !< Symmetric operator `type.op.type`.
         import :: parent_t
         class(parent_t), intent(in)  :: lhs
         class(parent_t), intent(in)  :: rhs
         class(parent_t), allocatable :: res
      end function Iparent_op_parent

   end interface

end module parent_m
module child_m

   use parent_m, only : parent_t

   implicit none

   private

   type, extends(parent_t), public :: child_t
      private
   contains
      procedure, pass(lhs) :: assign_parent => assign_child          !< Operator `=`.
      procedure, pass(rhs) :: real_times_parent                      !< Operator `real * type`.
      procedure, pass(lhs) :: parent_add_parent => child_add_parent  !< Operator `+`.
   end type child_t

contains

   pure subroutine assign_child(lhs, rhs)
   !< Operator `=`.
      class(child_t), intent(inout) :: lhs
      class(parent_t), intent(in)   :: rhs

      return

   end subroutine assign_child

   function real_times_parent(lhs, rhs) result( res )
   !< Operator `real * cons`.
      real,           intent(in)   :: lhs
      class(child_t), intent(in)   :: rhs
      class(parent_t), allocatable :: res

      allocate ( child_t :: res )

      return

   end function real_times_parent

   function child_add_parent(lhs, rhs) result( res )
   !< Operator `+`.
      class(child_t), intent(in)   :: lhs
      class(parent_t), intent(in)  :: rhs
      class(parent_t), allocatable :: res

      allocate ( child_t :: res )

      return

   end function child_add_parent

end module child_m
module m

   use parent_m, only : parent_t
   use child_m, only : child_t

   implicit none

contains

   subroutine sub1( foo, bar )

      class(parent_t), allocatable, intent(inout) :: foo
      class(parent_t), intent(inout) :: bar

      select type ( bar )
         type is ( child_t )
            bar = 0.5 * foo
         class default
      end select

      return

   end subroutine sub1

   subroutine sub2( foobar )

      class(parent_t), intent(inout) :: foobar

      type(child_t) :: foo
      type(child_t) :: bar

      select type ( foobar )
         type is ( child_t )
            foobar = 0.5 * ( foo + bar )
         class default
      end select

      return

   end subroutine sub2

end module m

Upon compilation,

Compiling with Intel(R) Visual Fortran Compiler 17.0.1.143 [Intel(R) 64]...
m.f90
m.f90(34): error #6633: The type of the actual argument differs from the type of the dummy argument.
ifort: error #10298: problem during post processing of parallel object compilation
compilation aborted for m.f90 (code 1)

 


Viewing all articles
Browse latest Browse all 415

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>