Added Adapter Pattern

README.md

@@ -15,7 +15,7 @@ Compiler Suggested: Fortran 90.
 - [X] Singleton
 
 #### Structural Patterns
-- [ ] Adapter
+- [X] Adapter
 - [ ] Bridge
 - [ ] Composite
 - [ ] Decorator
@@ -60,7 +60,6 @@ License
 	IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
 	CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
-Please refer to [1]:
 [1]: http://www.uml.org.cn/c++/pdf/DesignPatterns.pdf
 
 Contributions are welcome!

structural/adapter/adapter_main.f90

@@ -0,0 +1,38 @@
+!Copyright (c) 2013 Farhan J. Khan
+!THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+!IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
+!FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
+!COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
+!IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+!CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+!Main Program
+program adapter_main
+	use adapter_module
+
+	class(employee), allocatable :: e1
+	class(employee), allocatable :: e2
+	class(employee), allocatable :: e3
+	class(consultant), allocatable :: c1
+	type(consultantAdapter) :: ca
+
+	!2 employees and 1 consultant	
+	allocate(e1, source = concreteEmployee(10))
+	allocate(e2, source = concreteEmployee(20))
+	allocate(c1, source = concreteConsultant(30))
+
+	allocate(e3, source = e1)
+	call e3%showHappiness()
+	deallocate(e3)
+
+	allocate(e3, source = e2)
+	call e3%showHappiness()
+	deallocate(e3)
+
+	!consultant adapter acts as an employee
+	ca = consultantAdapter(c1)
+	allocate(e3, source =ca)
+	call e3%showHappiness()
+	deallocate(e3)
+
+end program adapter_main

structural/adapter/adapter_module.f90

@@ -0,0 +1,83 @@
+!Copyright (c) 2013 Farhan J. Khan
+!THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+!IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
+!FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
+!COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
+!IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+!CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+!Module for defining adapter
+module adapter_module
+	implicit none
+	!An employee
+	type, abstract :: employee
+		integer :: happiness = 0
+	contains
+		procedure(showHappinessInterface), deferred :: showHappiness
+	end type employee
+	abstract interface
+		subroutine showHappinessInterface(this)
+			import employee
+			class(employee), intent(in) :: this
+		end subroutine showHappinessInterface
+	end interface
+
+	!Employee implementation
+	type, extends(employee) :: concreteEmployee
+	contains
+		procedure :: showHappiness => showHappinessImpl
+	end type concreteEmployee
+
+	!Consultant (not an employee)
+	type, abstract :: consultant
+		integer :: smiles = 0
+	contains
+		procedure(showSmilesInterface), deferred :: showSmiles
+	end type consultant
+	abstract interface
+		subroutine showSmilesInterface(this)
+			import consultant
+			class(consultant), intent(in) :: this
+		end subroutine
+	end interface
+
+	!Consultant implementation
+	type, extends(consultant) :: concreteConsultant
+	contains
+		procedure :: showSmiles => showSmilesImpl
+	end type concreteConsultant
+
+	!Consultant adapter paves path between consultant and employee
+	type, extends(employee) :: consultantAdapter
+		class(consultant), allocatable :: c
+	contains
+		procedure :: showHappiness => showHappinessConsultantAdapterImpl
+	end type consultantAdapter
+
+	!Constructor for initializing the adapter
+	interface consultantAdapter
+ 	    module procedure init_consultantAdapter
+    end interface
+contains
+
+    type(consultantAdapter) function init_consultantAdapter(c)
+		class(consultant), intent(in) :: c
+        allocate(init_consultantAdapter%c, source = c)
+		init_consultantAdapter%happiness = c%smiles
+     end function
+
+	subroutine showHappinessImpl(this)
+		class(concreteEmployee), intent(in) :: this
+		print *, this%happiness
+	end subroutine showHappinessImpl
+
+	subroutine showSmilesImpl(this)
+		class(concreteConsultant), intent(in) :: this
+		print *, this%smiles
+	end subroutine
+
+	subroutine showHappinessConsultantAdapterImpl(this)
+		class(consultantAdapter), intent(in) :: this
+		print *, this%happiness	
+	end subroutine
+end module adapter_module