Task: Polymorphism






PHP: class Point
{
  protected $_x;

  protected $_y;
  
  public function __construct()
  {
    switch( func_num_args() )
    {
      case 1:
        $point = func_get_arg( 0 );
        $this->setFromPoint( $point );
        break;
      case 2:
        $x = func_get_arg( 0 );
        $y = func_get_arg( 1 );
        $this->setX( $x );
        $this->setY( $y );
        break;
      default:
        throw new InvalidArgumentException( 'expecting one (Point) argument or two (numeric x and y) arguments' );
    }
  }
  
  public function setFromPoint( Point $point )
  {
    $this->setX( $point->getX() );
    $this->setY( $point->getY() );
  }
  
  public function getX()
  {
    return $this->_x;
  }
  
  public function setX( $x )
  {
    if( !is_numeric( $x ) )
    {
      throw new InvalidArgumentException( 'expecting numeric value' );
    }
    
    $this->_x = (float) $x;
  }
  
  public function getY()
  {
    return $this->_y;
  }
  
  public function setY( $y )
  {
    if( !is_numeric( $y ) )
    {
      throw new InvalidArgumentException( 'expecting numeric value' );
    }
    
    $this->_y = (float) $y;
  }
  
  public function output()
  {
    echo $this->__toString();
  }
  
  public function __toString()
  {
    return 'Point [x:' . $this->_x . ',y:' . $this->_y . ']';
  }
}





Fortran: module geom

  type point
     real(8), private  :: x = 0
     real(8), private  :: y = 0
   contains
     procedure, public :: get_x
     procedure, public :: get_y
     procedure, public :: set_x
     procedure, public :: set_y
     procedure, public :: print => print_point
     procedure, pass :: copy_point
     
     generic, public :: assignment(=) => copy_point
  end type point

  type, extends(point) :: circle
     real(8), private  :: r = 0
   contains
     procedure, public :: get_r
     procedure, public :: set_r
     procedure, public :: print => print_circle
     procedure, pass :: copy_circle
     
     generic, public :: assignment(=) => copy_circle
  end type circle

  
  interface circle
  module procedure circle_constructor
  end interface circle
  
  interface point
  module procedure point_constructor
  end interface point

contains

  real(8) function get_x(this)
    class(point), intent(in) :: this
    get_x = this%x
  end function get_x

  real(8) function get_y(this)
    class(point), intent(in) :: this
    get_y = this%y
  end function get_y

  subroutine set_x(this, val)
    class(point), intent(inout) :: this
    real(8), intent(in)         :: val
    this%x = val
  end subroutine set_x

  subroutine set_y(this, val)
    class(point), intent(inout) :: this
    real(8), intent(in)         :: val
    this%y = val
  end subroutine set_y

  subroutine print_point(this)
    class(point), intent(in) :: this
    write(*,'(2(a,f0.4),a)') 'Point(',this%x,', ',this%y,')'
  end subroutine print_point

  real(8) function get_r(this)
    class(circle), intent(in) :: this
    get_r = this%r
  end function get_r

  subroutine set_r(this, val)
    class(circle), intent(inout) :: this
    real(8), intent(in)          :: val
    this%r = val
  end subroutine set_r

  subroutine print_circle(this)
    class(circle), intent(in) :: this
    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


  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

  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, 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