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 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119
| module StrategyInterface implicit none type, abstract :: StrategyType contains procedure(strategyExecute), deferred :: execute end type StrategyType
abstract interface subroutine strategyExecute(this, x, y, result) import :: StrategyType class(StrategyType), intent(in) :: this integer, intent(in) :: x, y integer, intent(out) :: result end subroutine strategyExecute end interface end module StrategyInterface
module AddStrategyModule use StrategyInterface implicit none type, extends(StrategyType) :: AddStrategy contains procedure :: execute => addExecute end type AddStrategy contains subroutine addExecute(this, x, y, result) class(AddStrategy), intent(in) :: this integer, intent(in) :: x, y integer, intent(out) :: result result = x + y end subroutine addExecute end module AddStrategyModule
module SubtractStrategyModule use StrategyInterface implicit none type, extends(StrategyType) :: SubtractStrategy contains procedure :: execute => subtractExecute end type SubtractStrategy contains subroutine subtractExecute(this, x, y, result) class(SubtractStrategy), intent(in) :: this integer, intent(in) :: x, y integer, intent(out) :: result result = x - y end subroutine subtractExecute end module SubtractStrategyModule
module MultiplyStrategyModule use StrategyInterface implicit none type, extends(StrategyType) :: MultiplyStrategy contains procedure :: execute => multiplyExecute end type MultiplyStrategy contains subroutine multiplyExecute(this, x, y, result) class(MultiplyStrategy), intent(in) :: this integer, intent(in) :: x, y integer, intent(out) :: result result = x * y end subroutine multiplyExecute end module MultiplyStrategyModule
module ContextModule use StrategyInterface implicit none type :: Context private class(StrategyType), allocatable :: strategy contains procedure :: setStrategy => setStrategyProc procedure :: executeStrategy => executeStrategyProc end type Context contains subroutine setStrategyProc(this, strategy) class(Context), intent(inout) :: this class(StrategyType), intent(in) :: strategy if (allocated(this%strategy)) then deallocate(this%strategy) end if allocate(this%strategy, source=strategy) end subroutine setStrategyProc
subroutine executeStrategyProc(this, x, y, result) class(Context), intent(in) :: this integer, intent(in) :: x, y integer, intent(out) :: result if (allocated(this%strategy)) then call this%strategy%execute(x, y, result) else write(*, *) "Error - strategy not set" end if end subroutine executeStrategyProc end module ContextModule
program main use ContextModule use AddStrategyModule use SubtractStrategyModule use MultiplyStrategyModule implicit none type(Context) :: cont integer :: result
call cont%setStrategy(AddStrategy()) call cont%executeStrategy(5, 3, result) write(*, *) "Result: ", result
call cont%setStrategy(SubtractStrategy()) call cont%executeStrategy(5, 3, result) write(*, *) "Result: ", result
call cont%setStrategy(MultiplyStrategy()) call cont%executeStrategy(5, 3, result) write(*, *) "Result: ", result
end program main
|