Another update from ingydotnet^djgoku

Task/Polymorphism/Fortran/polymorphism.f

@@ -9,6 +9,9 @@ module geom
      procedure, public :: set_x
      procedure, public :: set_y
      procedure, public :: print => print_point
+     procedure, pass :: copy_point
+     !overloaded assignment operator
+     generic, public :: assignment(=) => copy_point
   end type point
 
   type, extends(point) :: circle
@@ -17,8 +20,20 @@ module geom
      procedure, public :: get_r
      procedure, public :: set_r
      procedure, public :: print => print_circle
+     procedure, pass :: copy_circle
+     !overloaded assignment operator
+     generic, public :: assignment(=) => copy_circle
   end type circle
 
+  ! constructor interface
+  interface circle
+  module procedure circle_constructor
+  end interface circle
+  ! constructor interface
+  interface point
+  module procedure point_constructor
+  end interface point
+
 contains
 
   real(8) function get_x(this)
@@ -64,18 +79,51 @@ contains
     write(*,'(3(a,f0.4),a)') 'Circle(',this%x,', ',this%y,'; ',this%r,')'
   end subroutine print_circle
 
+  subroutine copy_point(this, rhs)
+      class(point), intent(inout) :: this
+      type(point), intent(in) :: rhs
+      this%x = rhs%x
+      this%y = rhs%y
+  end subroutine copy_point
+
+  subroutine copy_circle(this, rhs)
+      class(circle), intent(inout) :: this
+      type(circle), intent(in) :: rhs
+      this%x = rhs%x
+      this%y = rhs%y
+      this%r = rhs%r
+  end subroutine copy_circle
+
+! non-default constructor to init private components
+  type(point) function point_constructor(x,y)
+  real(8), intent(in) :: x,y
+  point_constructor%x = x
+  point_constructor%y = y
+  end function point_constructor
+! non-default constructor to init private components
+  type(circle) function circle_constructor(x,y,r)
+  real(8), intent(in) :: x,y,r
+  circle_constructor%x = x
+  circle_constructor%y = y
+  circle_constructor%r = r
+  end function circle_constructor
+
 end module geom
 
 program inh
   use geom
 
-  type(point)  :: p
-  type(circle) :: c
+  type(point)  :: p, p_copy
+  type(circle) :: c, c_copy
 
   p = point(2.0d0, 3.0d0)
   call p%print
+  p_copy = p
+  call p_copy%print
 
   c = circle(3.0d0, 4.0d0, 5.0d0)
   call c%print
+  c_copy = c
+  call c_copy%print
 
 end program inh