Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.
29230 Discussions

Problem with type bound operator - valid code rejected

MR
Beginner
523 Views

Another issue while experimenting with type bound operators: ifort (version 15.0) rejects the attached code, which I think is correct (some comments in the code itself, close to the line producing the error).

$ ifort -c test.f90

test.f90(34): warning #6178: The return value of this FUNCTION has not been defined.  
 pure recursive function unpck(x) result(y)
-----------------------------------------^
test.f90(40): warning #6178: The return value of this FUNCTION has not been defined.  
 elemental function cont_add(x,y) result(z)
-----------------------------------------^
test.f90(70): warning #6178: The return value of this FUNCTION has not been defined.  
 elemental function add(x,y) result(z)
------------------------------------^
test.f90(126): error #6355: This binary operation is invalid for this data type.   [DAT]
     allocate( z%f , source=new_t_b( x%dat + yunp ) )
---------------------------------------^
test.f90(126): error #6355: This binary operation is invalid for this data type.   [YUNP]
     allocate( z%f , source=new_t_b( x%dat + yunp ) )
---------------------------------------------^
test.f90(126): error #6549: An arithmetic or LOGICAL type is required in this context.
     allocate( z%f , source=new_t_b( x%dat + yunp ) )
-------------------------------------------^
test.f90(100): warning #6178: The return value of this FUNCTION has not been defined.   [NEWB]
 pure function new_t_b(dat) result(newb)
-----------------------------------^
compilation aborted for test.f90 (code 1)

module m1

 implicit none

 public :: &
   t_abstr, t_cont, unpck

 private

 type, abstract :: t_abstr
 contains
  private
  generic, public :: operator(+) => add
  procedure(i_add), pass(x), deferred :: add
 end type t_abstr

 type, extends(t_abstr) :: t_cont
  class(t_abstr), allocatable :: f
 contains
  procedure, private, pass(x) :: add => cont_add
 end type t_cont
 
 abstract interface
  elemental function i_add(x,y) result(z)
   import :: t_abstr, t_cont
   implicit none
   class(t_abstr), intent(in) :: x, y
   type(t_cont) :: z
  end function i_add
 end interface

contains

 pure recursive function unpck(x) result(y)
  class(t_abstr), intent(in) :: x
  class(t_abstr), allocatable :: y

 end function unpck

 elemental function cont_add(x,y) result(z)
  class(t_cont), intent(in) :: x
  class(t_abstr),  intent(in) :: y
  type(t_cont) :: z

 end function cont_add
 
end module m1

!-----------------------------------------------------------------------

module m2

 use m1, only: &
   t_abstr, t_cont, unpck

 implicit none

 public :: &
   t_a

 private

 type, extends(t_abstr) :: t_a
 contains
  procedure, private, pass(x) :: add
 end type t_a

contains

 elemental function add(x,y) result(z)
  class(t_a), intent(in) :: x
  class(t_abstr), intent(in) :: y
  type(t_cont) :: z

 end function add
end module m2

!-----------------------------------------------------------------------

module m3

 use m1, only: &
   t_abstr, t_cont, unpck

 use m2, only: &
   t_a

 implicit none

 private

 type, extends(t_abstr) :: t_b
  type(t_cont), allocatable :: dat(:)
 contains
  procedure, pass(x) :: add
 end type t_b

contains

 pure function new_t_b(dat) result(newb)
  type(t_cont), intent(in) :: dat(:)
  type(t_b) :: newb

 end function new_t_b

 elemental function add(x,y) result(z)
  class(t_b), intent(in) :: x
  class(t_abstr), intent(in) :: y
  type(t_cont) :: z

  class(t_abstr), allocatable :: yunp
 
   allocate( yunp , source=unpck(y) )
   select type(yunp)
    type is(t_a)

     ! Note:
     !
     ! x%dat has type  type(t_cont), allocatable, dimension(:)
     ! yunp has type  type(t_a)
     !
     ! Since both  t_cont  and  t_a  extend  t_abstr, the elemental
     ! type bound function "add" should be called. In particular,
     ! given that the first argument is the passed one, x%dat%cont_add
     ! should be called.
     allocate( z%f , source=new_t_b( x%dat + yunp ) )

   end select

 end function add

end module m3

 

0 Kudos
1 Reply
Kevin_D_Intel
Employee
523 Views

I reproduced the errors with 15.0 and the upcoming 16.0 compilers. It compiles with gfortran 5.1. I will send this to our Developers and update you on what I hear.

(Internal tracking id: DPD200374263)

0 Kudos
Reply