Quantcast
Channel: Intel® Fortran Compiler
Viewing all articles
Browse latest Browse all 3270

problem with deferred assignment overloading

$
0
0

I believe the code below is "legal". However, ifort (14.0.1 20131008), with default options (i.e. "ifort -c") gives this error:

ifort_reproducer_140226.f90(90): error #6197: An assignment of different structure types is invalid.   [TEST_WAYPOINTS]
        test_points = test_waypoints
----------------------^
ifort_reproducer_140226.f90(91): error #6197: An assignment of different structure types is invalid.   [TEST_WAYPOINT]
        test_point = test_waypoint
---------------------^
compilation aborted for ifort_reproducer_140226.f90 (code 1)

For what it's worth, the NAG and Portland compilers do not have a problem with this code.

Is it indeed legal? If not, what is the correct way to do deferred assignment overloading?

Is there a workaround for ifort?

module coos
    implicit none

    type, abstract :: abstract_point
        real(kind=8)    ::  coo(3)  =   [0.0d0,0.0d0,0.0d0]
        contains
            private
            procedure(ass_abstract),    deferred        ::  my_assignment
            generic, public                             ::  assignment(=) => my_assignment
    end type abstract_point

    abstract interface
        pure elemental subroutine ass_abstract(lhs,rhs)
            import :: abstract_point
            class(abstract_point),   intent(inout)      ::  lhs
            class(abstract_point),   intent(in)         ::  rhs
        end subroutine
    end interface

    type, extends(abstract_point)       ::  point
        !
        contains
            procedure                   ::  my_assignment   => assign_point_to_point
    end type point

    type, extends(abstract_point)       ::  waypoint
        logical                         ::  refine      =   .true.
        real(kind=8)                    ::  path_length =   0.0d0
        contains
            procedure                   ::  my_assignment   =>  assign_point_to_waypoint
    end type

    contains

    pure elemental subroutine assign_point_to_point(lhs,rhs)
        ! arguments
        class(point),           intent(inout)       ::  lhs
        class(abstract_point),  intent(in)          ::  rhs
        ! start work
        lhs%coo = rhs%coo
    end subroutine assign_point_to_point

    pure elemental subroutine assign_point_to_waypoint(lhs,rhs)
        ! arguments
        class(waypoint),        intent(inout)       ::  lhs
        class(abstract_point),  intent(in)          ::  rhs
        ! start work
        lhs%coo = rhs%coo
        select type(rhs)
            class is (waypoint)
                call waypoint_assign(lhs,rhs)
        end select
    end subroutine assign_point_to_waypoint

    pure elemental subroutine waypoint_assign(wp_lhs,wp_rhs)
        ! arguments
        type(waypoint), intent(inout)   ::  wp_lhs
        type(waypoint), intent(in)      ::  wp_rhs
        ! start work
        wp_lhs%coo          =   wp_rhs%coo
        wp_lhs%path_length  =   wp_rhs%path_length
        wp_lhs%refine       =   wp_rhs%refine
    end subroutine waypoint_assign

    pure elemental subroutine waypoint_init(self)
        ! arguments
        type(waypoint),                 intent(inout)   ::  self
        ! start work
        self%coo = 0.0d0
        self%refine      =   .true.
        self%path_length =   0.0d0
    end subroutine waypoint_init


    subroutine coos_unit_test_1()
        ! private variables
        type(point),        allocatable ::  test_points(:)
        type(waypoint),     allocatable ::  test_waypoints(:)
        type(point)                     ::  test_point
        type(waypoint)                  ::  test_waypoint
        ! start work

        allocate(test_waypoints(10))
        call waypoint_init(test_waypoints)
        test_waypoints(2)%coo(1) = 12.3
        call waypoint_init(test_waypoint)
        test_waypoint%coo(1) = 12.3

        allocate(test_points(size(test_waypoints)))
        test_points = test_waypoints
        test_point = test_waypoint
    end subroutine coos_unit_test_1

end module coos

 


Viewing all articles
Browse latest Browse all 3270