A suggested in the answer of Federico Perini(https://stackoverflow.com/a/72998466/7462275), I tried to write a factory to hide away all of the complexity in a separate module.
But, I do not manage to put in the module the init routine because the number of arguments depends of the object type (line, rectangle or box).
This is the code that I wrote but the I still have a select type in the main. And, I did not manage to put it in the module.
module myModule
implicit none
type CFactory
class(shape_t), pointer :: shape_type
contains
procedure :: create_shape
end type CFactory
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 create_shape(this,choice)
class(CFactory), intent(inout) :: this
integer, intent(in) :: choice
select case (choice)
case(1)
allocate(line_t::this%shape_type)
case(2)
allocate(rectangle_t::this%shape_type)
case(3)
allocate(box_t::this%shape_type)
case default
print *,'not permitted'
stop
end select
end subroutine create_shape
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
program main
use myModule
implicit none
type(CFactory) :: factory
integer :: choice
print *,'choice (1:line, 2:rectangle or 3:box)'
read(*,'(i1)') choice
call factory%create_shape(choice)
select type (ptr => factory%shape_type)
type is (line_t)
call ptr%init(4.0)
type is (rectangle_t)
call ptr%init(4.0,3.0)
type is (box_t)
call ptr%init(4.0,3.0,2.0)
end select
call factory%shape_type%print_size()
end program main
I tried many things to have only in the main call factory%shape_type%someinitprocedure with one, or two or three arguments (for line, rectangular or box). Of course, a check will be performed in this subroutine to be sure that the number of arguments agrees with the shape_type.
(n.b. : I am discovering the factory concept, so my strategy is not the good one to hide away the complexity in a module)
Thanks for answer
In your example, shape sizes (width, length, depth) are a property of the instantiated object. You're not initializing a generic box or a generic line (that is what a derived type represents) but THAT box, with that width, length, depth (assume they can never change, for now).
So you want to have them set once and forall in the factory, where you can also do all your nice checks. Think something like:
module shape_factory
use shape_types ! where the class definitions are
implicit none
type, public :: shape_creator
! Configuration variables
real :: max_width = blabla
real :: min_depth = etcetc
! Some stats
integer :: created_sofar = 0
contains
procedure :: create => init_shape
end type shape_creator
contains
subroutine init_shape(this, the_shape, which_type, width, length, depth, radius)
class(shape_creator), intent(inout) :: this
class(shape_t), allocatable, intent(out) :: the_shape
integer, intent(in) :: which
real, optional, intent(in) :: width, length, depth, radius
select case (which_type)
case (1); allocate(box_t :: the_shape)
if (.not.present(width)) stop 'width is mandatory for box_t'
if (.not.present(depth)) stop 'depth is mandatory for box_t'
if (.not.present(length)) stop 'length is mandatory for box_t'
the_shape = box_t(width, depth,length)
case (2); allocate(circle_t :: the_shape)
if (.not.present(radius)) stop 'radius is mandatory for circle_t'
the_shape = circle_t(radius)
case default
stop 'shape factory: invalid shape type requested '
end select
! Keep counter
this%created_sofar = this%created_sofar + 1
end subroutine init_shape
end module shape_factory
program create_shapes
use shape_factory
use shape_types
type(shape_creator) :: factory
class(shape_t), allocatable :: shape
call factory%create(shape,2,radius=0.5); call shape%print()
call factory%create(shape,1,width=1.0); ! Error! not enough arguments
! etc.
end program