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
|
! { dg-do compile }
!
! PR fortran/51995
!
! Contributed by jilfa12@yahoo.com
!
MODULE factory_pattern
TYPE CFactory
PRIVATE
CHARACTER(len=20) :: factory_type !! Descriptive name for database
CLASS(Connection), POINTER :: connection_type !! Which type of database ?
CONTAINS !! Note 'class' not 'type' !
PROCEDURE :: init !! Constructor
PROCEDURE :: create_connection !! Connect to database
PROCEDURE :: finalize !! Destructor
END TYPE CFactory
TYPE, ABSTRACT :: Connection
CONTAINS
PROCEDURE(generic_desc), DEFERRED, PASS(self) :: description
END TYPE Connection
ABSTRACT INTERFACE
SUBROUTINE generic_desc(self)
IMPORT :: Connection
CLASS(Connection), INTENT(in) :: self
END SUBROUTINE generic_desc
END INTERFACE
!! An Oracle connection
TYPE, EXTENDS(Connection) :: OracleConnection
CONTAINS
PROCEDURE, PASS(self) :: description => oracle_desc
END TYPE OracleConnection
!! A MySQL connection
TYPE, EXTENDS(Connection) :: MySQLConnection
CONTAINS
PROCEDURE, PASS(self) :: description => mysql_desc
END TYPE MySQLConnection
CONTAINS
SUBROUTINE init(self, string)
CLASS(CFactory), INTENT(inout) :: self
CHARACTER(len=*), INTENT(in) :: string
self%factory_type = TRIM(string)
self%connection_type => NULL() !! pointer is nullified
END SUBROUTINE init
SUBROUTINE finalize(self)
CLASS(CFactory), INTENT(inout) :: self
DEALLOCATE(self%connection_type) !! Free the memory
NULLIFY(self%connection_type)
END SUBROUTINE finalize
FUNCTION create_connection(self) RESULT(ptr)
CLASS(CFactory) :: self
CLASS(Connection), POINTER :: ptr
IF(self%factory_type == "Oracle") THEN
IF(ASSOCIATED(self%connection_type)) DEALLOCATE(self%connection_type)
ALLOCATE(OracleConnection :: self%connection_type)
ptr => self%connection_type
ELSEIF(self%factory_type == "MySQL") THEN
IF(ASSOCIATED(self%connection_type)) DEALLOCATE(self%connection_type)
ALLOCATE(MySQLConnection :: self%connection_type)
ptr => self%connection_type
END IF
END FUNCTION create_connection
SUBROUTINE oracle_desc(self)
CLASS(OracleConnection), INTENT(in) :: self
WRITE(*,'(A)') "You are now connected with Oracle"
END SUBROUTINE oracle_desc
SUBROUTINE mysql_desc(self)
CLASS(MySQLConnection), INTENT(in) :: self
WRITE(*,'(A)') "You are now connected with MySQL"
END SUBROUTINE mysql_desc
end module
PROGRAM main
USE factory_pattern
IMPLICIT NONE
TYPE(CFactory) :: factory
CLASS(Connection), POINTER :: db_connect => NULL()
CALL factory%init("Oracle")
db_connect => factory%create_connection() !! Create Oracle DB
CALL db_connect%description()
!! The same factory can be used to create different connections
CALL factory%init("MySQL") !! Create MySQL DB
!! 'connect' is a 'class' pointer. So can be used for either Oracle or MySQL
db_connect => factory%create_connection()
CALL db_connect%description()
CALL factory%finalize() ! Destroy the object
END PROGRAM main
|
