Home > Blockchain >  OOP fortran : Must I keep the abstract interface in this program?
OOP fortran : Must I keep the abstract interface in this program?

Time:07-16

Following the second option suggested by Federico Perini in Fortran : Is it possible to overload a procedure in a abstract interface?, I wrote this code.

module myModule
    implicit none

    type, abstract :: shape_t
    contains

        ! Put init in a generic interface
        procedure(abstract_init), deferred, private  :: shared_init
        generic :: init => shared_init

        procedure(abstract_print), deferred :: print_size
    end type shape_t

    abstract interface
        subroutine abstract_init(this,length1,length2,length3)
            import shape_t
            class(shape_t), intent(inout) :: this
            real, intent(in) :: length1,length2,length3
        end subroutine abstract_init

        subroutine abstract_print(this)
            import shape_t
            class(shape_t), intent(in) :: this
        end subroutine abstract_print
    end interface

    type, extends(shape_t) :: line_t
        real :: length
    contains
        procedure :: shared_init => init_line
        procedure :: init_line_1d
        generic   :: init => init_line_1d
        procedure :: print_size => print_linesize
    end type line_t

     type, extends(shape_t) :: rectangle_t
        real :: length,width
    contains
        procedure :: shared_init => init_rectangle
        procedure :: init_rectangle_2d
        generic   :: init => init_rectangle_2d
        procedure :: print_size => print_rectanglesize
    end type rectangle_t

    type, extends(shape_t) :: box_t
        real :: length,width,height
    contains
        procedure :: shared_init => init_box
        procedure :: print_size => print_boxsize
    end type box_t

contains
    subroutine init_line_1d(this,length1)
        class(line_t), intent(inout) :: this
        real, intent(in) :: length1
        this%length = length1
    end subroutine init_line_1d
    subroutine init_line(this,length1,length2,length3)
        class(line_t), intent(inout) :: this
        real, intent(in) :: length1,length2,length3
        call init_line_1d(this,length1)
    end subroutine init_line

    subroutine print_linesize(this)
        class(line_t), intent(in) :: this
        print*,'Line size',this%length,'meter'
    end subroutine print_linesize

    subroutine init_rectangle(this,length1,length2,length3)
        class(rectangle_t), intent(inout) :: this
        real, intent(in) :: length1,length2,length3
        call init_rectangle_2d(this,length1,length2)
    end subroutine init_rectangle
    subroutine init_rectangle_2d(this,length1,length2)
        class(rectangle_t), intent(inout) :: this
        real, intent(in) :: length1,length2
        this%length = length1
        this%width = length2
    end subroutine init_rectangle_2d

    subroutine print_rectanglesize(this)
        class(rectangle_t), intent(in) :: this
        print*,'Rectangle area',this%length*this%width,'meter^2'
    end subroutine print_rectanglesize

        subroutine init_box(this,length1,length2,length3)
        class(box_t), intent(inout) :: this
        real, intent(in) :: length1,length2,length3
        this%length = length1
        this%width = length2
        this%height = length3
    end subroutine init_box

    subroutine print_boxsize(this)
        class(box_t), intent(in) :: this
        print*,'Box volume',this%length*this%width*this%height,'meter^3'
    end subroutine print_boxsize

end module myModule

program main

    use myModule

    implicit none

    class(shape_t), allocatable :: dynamic_typing
    integer :: choice
    
    print *,'choice (1:line, 2:rectangle or 3:box)'
    read(*,'(i1)') choice
    select case (choice)
        case(1)
            allocate(line_t::dynamic_typing)
        case(2)
            allocate(rectangle_t::dynamic_typing)
        case(3)
            allocate(box_t::dynamic_typing)
        case default
            print *,'not permitted'
            stop
    end select
    
    select type (dynamic_typing)
        type is (line_t)
            call dynamic_typing%init(4.0)
            call dynamic_typing%print_size()
        type is (rectangle_t)
            call dynamic_typing%init(4.0,3.0)
            call dynamic_typing%print_size()
        type is (box_t)
            call dynamic_typing%init(4.0,3.0,2.0)
            call dynamic_typing%print_size()
    end select

end program main

But, shared_init in the abstract interface made me wonder. On one hand, it is useful because, an init procedure is mandatory in derived type. But, a subroutine (init_line, init_rectangle, init_box) not used must be written for each derived type. And as it contains all parameters, if a new derived type is added with another parameters (an integer, a logical, or whatever), the abstract interface must be changed and consequently all subroutines mentionned above. It seems me very difficult to maintain (but I am not an OOP specialist).
In first intention, I removed the deferred procedure abstract_init and I keep only procedure :: init_line_1d and generic :: init => init_line_1d (idem for rectangle and box) in the definition of the derived type. but in this case, init was not mandatory and it bothered me. So, I have written the code below where it is mandatory to have an init procedure. But, this procedure is very short and has no parameter. And, new derived type could be easily added with new parameters, without changing code for the previous defined.

module myModule
    implicit none

    type, abstract :: shape_t
    contains
        ! Put init in a generic interface
        procedure(abstract_init), nopass, deferred, private  :: shared_init
        generic :: init => shared_init

        procedure(abstract_print), deferred :: print_size
    end type shape_t

    abstract interface
        subroutine abstract_init()
        end subroutine abstract_init

        subroutine abstract_print(this)
            import shape_t
            class(shape_t), intent(in) :: this
        end subroutine abstract_print
    end interface

    type, extends(shape_t) :: line_t
        real :: length
    contains
        procedure, nopass, private :: shared_init => init_line
        procedure :: init_line_1d
        generic   :: init => init_line_1d
        procedure :: print_size => print_linesize
    end type line_t

     type, extends(shape_t) :: rectangle_t
        real :: length,width
    contains
        procedure, nopass, private :: shared_init => init_rectangle
        procedure :: init_rectangle_2d
        generic   :: init => init_rectangle_2d
        procedure :: print_size => print_rectanglesize
    end type rectangle_t

    type, extends(shape_t) :: box_t
        real :: length,width,height
    contains
        procedure, nopass, private :: shared_init => init_box
        procedure :: init_box_3d
        generic   :: init => init_box_3d
        procedure :: print_size => print_boxsize
    end type box_t

contains
    subroutine init_line_1d(this,length1)
        class(line_t), intent(inout) :: this
        real, intent(in) :: length1
        this%length = length1
    end subroutine init_line_1d
    subroutine print_linesize(this)
        class(line_t), intent(in) :: this
        print*,'Line size',this%length,'meter'
    end subroutine print_linesize

    subroutine init_rectangle_2d(this,length1,length2)
        class(rectangle_t), intent(inout) :: this
        real, intent(in) :: length1,length2
        this%length = length1
        this%width = length2
    end subroutine init_rectangle_2d   
    subroutine print_rectanglesize(this)
        class(rectangle_t), intent(in) :: this
        print*,'Rectangle area',this%length*this%width,'meter^2'
    end subroutine print_rectanglesize

    subroutine init_box_3d(this,length1,length2,length3)
        class(box_t), intent(inout) :: this
        real, intent(in) :: length1,length2,length3
        this%length = length1
        this%width = length2
        this%height = length3
    end subroutine init_box_3d
    subroutine print_boxsize(this)
        class(box_t), intent(in) :: this
        print*,'Box volume',this%length*this%width*this%height,'meter^3'
    end subroutine print_boxsize

    subroutine init_rectangle() ; end subroutine init_rectangle
    subroutine init_line() ; end subroutine init_line
    subroutine init_box() ; end subroutine init_box
    
end module myModule

But, as I am a beginner in OOP, I wonder if it is a good idea or totally stupid. Thank for answer.

CodePudding user response:

The reason abstract interfaces exist is to define a common template that all extended types need to comply to. In your example, you could have such interfaces to mandate properties that are shared across all them. For example (to name a couple):

abstract interface
   elemental real(real64) function shape_area(this) result(A)
      class(shape_t), intent(in) :: this
   end function shape_area
   elemental real(real64) function shape_perimeter(this) result(p2)
      class(shape_t), intent(in) :: this
   end function shape_perimeter
end interface

Initializers for different extended types clearly will never comply to that interface being always the same (otherwise, there would be no need to have a polymorphic class), so, some strategy needs to be put in place. For simple cases like yours, I think the most compact/easy/understandable thing to do is to use default type initializers:

select type (new)
   type is (rectangle_t); new = rectangle_t(width,length)
   type is (line_t);      new = line_t(length)
   type is (box_t);       new = box_t(length,width,height)
   class default;         stop 'catastrophic error!'
end select

Otherwise, you need to have a factory that hides away all of the complexity in a separate module.

  • Related