Tests/UseSWIG/runme.f90

! File : runme.f90
program runme
  use ISO_FORTRAN_ENV
  implicit none
  integer, parameter :: STDOUT = OUTPUT_UNIT

  call run()
contains

subroutine run()
  use example
  use iso_c_binding
  implicit none

  type(Circle)          :: c
  type(Square), target  :: s ! 'target' allows it to be pointed to
  class(Shape), pointer :: sh
  integer(C_INT) :: n_shapes

  ! ----- Object creation -----

  write(STDOUT,*) "Creating some objects"
  c = Circle(10.0d0)
  s = Square(10.0d0)

  ! ----- Access a static member -----
  write(STDOUT,'(a,i2,a)')"A total of", s%get_nshapes(), " shapes were created"

  ! ----- Member data access -----

  ! Notice how we can do this using functions specific to
  ! the 'Circle' class.
  call c%set_x(20.0d0)
  call c%set_y(30.0d0)

  ! Now use the same functions in the base class
  sh => s
  call sh%set_x(-10.0d0)
  call sh%set_y(  5.0d0)

  write(STDOUT,*)"Here is their current position:"
  write(STDOUT,'(a,f5.1,a,f5.1,a)')"  Circle = (", c%get_x(), ",", c%get_y(), " )"
  write(STDOUT,'(a,f5.1,a,f5.1,a)')"  Square = (", s%get_x(), ",", s%get_y(), " )"

  ! ----- Call some methods -----

  write(STDOUT,*)"Here are some properties of the shapes:"
  call print_shape(c)
  call print_shape(s)

  ! ----- Delete everything -----

  ! Note: this invokes the virtual destructor
  call c%release()
  call s%release()

  n_shapes = c%get_nshapes()
  write(STDOUT,*) n_shapes, "shapes remain"
  if (n_shapes /= 0) then
    write(STDOUT,*) "Shapes were not freed properly!"
    stop 1
  endif

  write(STDOUT,*) "Goodbye"
end subroutine

subroutine print_shape(s)
  use example, only : Shape
  use iso_c_binding
  implicit none
  class(Shape), intent(in) :: s

  write(STDOUT,*)"    area      = ",s%area()
  write(STDOUT,*)"    perimeter = ",s%perimeter()
end subroutine

end program