1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
! 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
|
