Generic type-bound procedure with reload operator(+)

[oleglebedev]

Good day,

I have had the error with my test code a couple of days. I thought I can solve it myself... ))

[fortran]!!! there is a point - class
MODULE point_class
    IMPLICIT NONE
!
PRIVATE
!
TYPE, public :: point
  PRIVATE
  integer, dimension(:), allocatable :: xx
  logical :: isAllocated = .FALSE.
    CONTAINS
    PRIVATE
      procedure, public :: setPoint => setPoint_sub
      procedure, public :: getPoint => getPoint_fn
      procedure, public :: size => getSize
      procedure, public :: show => toScreen
      procedure, public :: moreInfo => moreInfo_fn
      procedure :: point_plus_point
      procedure :: point_plus_array
      procedure :: point_to_point
      procedure :: array_to_point
      generic :: assignment (=) => point_to_point, array_to_point
      generic :: operator (+) => point_plus_point, point_plus_array
      final :: deallocate_xx
END TYPE point
!
!
    INTERFACE max_size
      MODULE PROCEDURE max_point_point
      MODULE PROCEDURE max_point_array
    END INTERFACE
!
!
    CONTAINS
!
RECURSIVE subroutine setPoint_sub(this, array)
    implicit none
    class(point), intent(INOUT) :: this
    integer, dimension(:), intent(IN) :: array
    integer :: istat
if ( .NOT. this%isAllocated ) then
  allocate( this%xx(1:size(array)), STAT=istat )
  if ( istat /= 0 ) stop 'can not ALLOCATE this%xx'
  this%xx = array
  this%isAllocated = .TRUE.
else
  deallocate( this%xx )
  this%isAllocated = .FALSE.
  call setPoint_sub( this, array )
end if
return
end subroutine setPoint_sub
!
!
ELEMENTAL integer function getPoint_fn(this, i) RESULT(res)
    implicit none
    class(point), intent(IN) :: this
    integer, intent(IN) :: i
if ( this%isAllocated ) then
  res = this%xx(i)
else
  res = 0
end if
return
end function getPoint_fn
!
!
ELEMENTAL integer function getSize(this) RESULT(res)
    implicit none
    class(point), intent(IN) :: this
if ( this%isAllocated ) then
  res = size( this%xx )
else
  res = 0
end if
return
end function getSize
!
!
ELEMENTAL integer function moreInfo_fn(this) RESULT(res)
    implicit none
    class(point), intent(IN) :: this
if ( this%isAllocated ) then
  res = sizeof( this%xx )
else
  res = 0
end if
return
end function moreInfo_fn
!
!
subroutine toScreen(this)
    implicit none
    class(point), intent(IN) :: this
    integer :: i
if ( this%isAllocated ) write( *, 1 ) ( this%getPoint(i), i=1,this%size() )
1 format ( :, 1X, 100i5 )
return
end subroutine toScreen
!
!
!!!>{
!!!>-- OPERATOR ( + ) ---- the problem is with this function ---- ASSIGNMENT ( = ) ---- error code with operator (+) --

[IanH]

On line 12 of your module you have a PRIVATE statement that sets the default accessibility for all bindings in the Point type to be private.

If you want to use certain bindings in program units other than the module you either need to remove that private statement (which makes the default accessibility for bindings public) or add the public attribute to the generic bindings that you want accessible (as you have done for some of the specific bindings).

[oleglebedev]

Ok, but the assignment binding has PRIVATE statement, too (line 22).

On 17 and 19 lines of main program I coded t2=t1 and t1=t2, respectivly. It was compiled and executed without error. And it works as I want it.

[IanH]

If the generic binding for assignment is private, then both assignments in the main program are simply Fortran 90 style intrinsic assignments. Your specific bindings that implement the defined assignment are not being called.

(With the generic binding for assignment still private, try t1 = [1,2,3,4,5] and see what error you get.)

[oleglebedev]

I supposed that generic bindings are public.

[oleglebedev]

I have another quaestion about inherit type.

[fortran]MODULE first_class
    IMPLICIT NONE
!
PRIVATE
!
TYPE, public :: first
  PRIVATE
  integer :: xx
    CONTAINS
    PRIVATE
      procedure, public :: setX => setX_sub
      procedure, public :: getX => getX_fn
      procedure :: x_plus_x 
      generic, public :: operator(+) => x_plus_x
END TYPE first
!
!
    CONTAINS
!
PURE subroutine setX_sub(this, xx)
    implicit none
    class(first), intent(INOUT) :: this
    integer, intent(IN) :: xx
this%xx = xx
return
end subroutine setX_sub
!
!
ELEMENTAL integer function getX_fn(this) RESULT(res)
    implicit none
    class(first), intent(IN) :: this
res = this%xx
return
end function getX_fn
!
!
ELEMENTAL type(first) function x_plus_x(x1, x2) RESULT(res)
    implicit none
    class(first), intent(IN) :: x1, x2
res%xx = x1%xx + x2%xx
return
end function x_plus_x
!
!
END MODULE first_class

MODULE second_class
    USE first_class
    IMPLICIT NONE
!
PRIVATE
!
TYPE, extends(first), public :: second
  PRIVATE
  integer :: yy
    CONTAINS
    PRIVATE
      procedure, public :: set => setXY_sub
      procedure, public :: setY => setY_sub
      procedure, public :: getY => getY_fn
      procedure :: y_plus_y
      generic, public :: operator(+) => y_plus_y
END TYPE second
!
!
    CONTAINS
!
PURE subroutine setXY_sub(this, x, y)
    implicit none
    class(second), intent(INOUT) :: this
    integer, intent(IN) :: x, y
call this%setX(x)
this%yy = y
return
end subroutine setXY_sub
!
!
PURE subroutine setY_sub(this, yy)
    implicit none
    class(second), intent(INOUT) :: this
    integer, intent(IN) :: yy
this%yy = yy
return
end subroutine setY_sub
!
!
ELEMENTAL integer function getY_fn(this) RESULT(res)
    implicit none
    class(second), intent(IN) :: this
res = this%yy
return
end function getY_fn
!
!
ELEMENTAL type(second) function y_plus_y(x1, x2) RESULT(res)
    implicit none
    class(second), intent(IN) :: x1, x2
!!!>-- I must type this line to add x1%xx + x2%xx ---- The generic-public reload operator of first class doesn`t inherit, does it? --