Criteria Pattern Completed

README.md

@@ -18,6 +18,7 @@ Tested on: GNU Fortran (GCC) 4.8.
 - [X] Adapter
 - [X] Bridge
 - [X] Composite
+- [X] Criteria
 - [ ] Decorator
 - [ ] Façade
 - [ ] Flyweight

structural/criteria/criteria_main.f90

@@ -1,13 +1,26 @@
+!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 criteria_main
 	use criteria_module
 	implicit none
 	type(person), allocatable :: persons(:)
+	type(person), allocatable :: outPersons(:)
 	class(criteria), allocatable :: cmale	
 	class(criteria), allocatable :: cfemale	
 	class(criteria), allocatable :: csingle
 	class(criteria), allocatable :: cand
 	class(criteria), allocatable :: cor	
-
+	type(andcriteria) :: and_criteria
+	type(orcriteria) :: or_criteria
+
+	!Initialize array with list of persons
 	allocate(persons(6))
 	persons(1) = person('Robert', 'm', 's')
 	persons(2) = person('John', 'm', 'm')
@@ -19,14 +32,42 @@ program criteria_main
 	allocate(cmale, source=malecriteria())
 	allocate(cfemale, source=femalecriteria())
 	allocate(csingle, source=singlecriteria())
-	allocate(cand, source=andcriteria(cmale, null()))
-!	allocate(cor, source=orcriteria(csingle, cfemale))
 
-!	deallocate(persons)
-!	deallocate(cmale)
-!	deallocate(cfemale)
-!	deallocate(csingle)
-!	deallocate(cand)
-!	deallocate(cor)
+	!All males
+	call cmale%meetcriteria(persons, outPersons)
+	print *, 'Males:'
+	call printPersonArray(outPersons)
+	deallocate(outPersons)
+
+	!All females
+	call cfemale%meetcriteria(persons, outPersons)
+	print *, 'Females:'
+	call printPersonArray(outPersons)
+	deallocate(outPersons)
+
+	!Male and Single
+	allocate(and_criteria%c1, source = malecriteria())
+	allocate(and_criteria%c2, source = singlecriteria())
+	allocate(cand, source=and_criteria)
+	call cand%meetCriteria(persons, outPersons)
+	print *, 'Single Males:'
+	call printPersonArray(outPersons)
+	deallocate(outPersons)
+
+	!Single or Female
+	allocate(or_criteria%c1, source = singlecriteria())
+	allocate(or_criteria%c2, source = femalecriteria())
+	allocate(cor, source=or_criteria)
+	call cor%meetCriteria(persons, outPersons)
+	print *, 'Single Or Females:'
+	call printPersonArray(outPersons)
+	deallocate(outPersons)
+
+	deallocate(persons)
+	deallocate(cmale)
+	deallocate(cfemale)
+	deallocate(csingle)
+	deallocate(cand)
+	deallocate(cor)
 
 end program criteria_main

structural/criteria/criteria_module.f90

@@ -1,18 +1,28 @@
-!TODO: this needs to be complete and is not in usable format for now
+!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 providing implementation of criteria pattern
 module criteria_module
 	implicit none
 
+	!Person type
 	type, public :: person
-		character(20) :: name
+		character(10) :: name
 		character(1) :: gender
 		character(1) :: maritalstatus
 	end type person
 
+	!Criteria type with meetCriteria interface
 	type, abstract :: criteria
 	contains
 		procedure(meetCriteriaInterface), deferred :: meetCriteria
 	end type
+	!Interface defination for meetCriteria
 	abstract interface
 		subroutine meetCriteriaInterface(this, personArray, outPersonArray)
 			import criteria
@@ -54,14 +64,34 @@ end subroutine meetCriteriaInterface
 
 contains
 
+	!Genralized method to dynamically increase the size of array and put value at pos.
+	subroutine putInArray(array, pos, value)
+		type(person), dimension (:), allocatable, intent(inout) :: array(:)
+		integer :: pos
+		type(person), intent(in) :: value
+		type(person), dimension (:), allocatable :: tempArray(:)
+
+		allocate(tempArray(pos))
+		tempArray(1:pos) = array
+		deallocate(array)
+		call move_alloc(tempArray, array)
+		array(pos) = value
+	end subroutine putInArray
+
 	subroutine meetMaleCriteria(this, personArray, outPersonArray)
 		class(maleCriteria), intent(in) :: this
 		type(person), dimension (:), allocatable, intent(inout) :: personArray(:)
 		type(person), dimension (:), allocatable, intent(inout) :: outPersonArray(:)
-		integer :: j
+		integer :: j, k
+		!initializing outPersonArray to avoid segmentation fault
+		if (.not. allocated(outPersonArray)) then
+			allocate(outPersonArray(1))
+		endif
+		k = 0
 		do j=1,size(personArray)
 			if (personArray(j)%gender .EQ. 'm') then
-				outPersonArray(j) = personArray(j)
+				k = k + 1
+				call putInArray(outPersonArray, k, personArray(j))
 			end if
 		enddo
 	end subroutine meetMaleCriteria
@@ -70,10 +100,16 @@ subroutine meetFemaleCriteria(this, personArray, outPersonArray)
 		class(femaleCriteria), intent(in) :: this
 		type(person), dimension (:), allocatable, intent(inout) :: personArray(:)
 		type(person), dimension (:), allocatable, intent(inout) :: outPersonArray(:)
-		integer :: j
+		integer :: j, k
+
+		if (.not. allocated(outPersonArray)) then
+			allocate(outPersonArray(1))
+		endif
+		k = 0
 		do j=1,size(personArray)
 			if (personArray(j)%gender .EQ. 'f') then
-				outPersonArray(j) = personArray(j)
+				k = k + 1
+				call putInArray(outPersonArray, k, personArray(j))
 			end if
 		enddo
 	end subroutine meetFemaleCriteria
@@ -82,10 +118,16 @@ subroutine meetSingleCriteria(this, personArray, outPersonArray)
 		class(singleCriteria), intent(in) :: this
 		type(person), dimension (:), allocatable, intent(inout) :: personArray(:)
 		type(person), dimension (:), allocatable, intent(inout) :: outPersonArray(:)
-		integer :: j
+		integer :: j, k
+
+		if (.not. allocated(outPersonArray)) then
+			allocate(outPersonArray(1))
+		endif
+		k = 0
 		do j=1,size(personArray)
 			if (personArray(j)%maritalstatus .EQ. 's') then
-				outPersonArray(j) = personArray(j)
+				k = k + 1
+				call putInArray(outPersonArray, k, personArray(j))
 			end if
 		enddo
 	end subroutine meetSingleCriteria
@@ -95,8 +137,14 @@ subroutine meetAndCriteria(this, personArray, outPersonArray)
 		type(person), dimension (:), allocatable, intent(inout) :: personArray(:)
 		type(person), dimension (:), allocatable, intent(inout) :: outPersonArray(:)
 		type(person), dimension (:), allocatable :: tempPersonArray(:)
+		allocate(tempPersonArray(1))
+		!First criteria (output in tempPersonArray)
 		call this%c1%meetCriteria(personArray, tempPersonArray)
-		call this%c1%meetCriteria(temppersonArray, outPersonArray)
+		if (.not. allocated(outPersonArray)) then
+			allocate(outPersonArray(1))
+		endif
+		!Apply second criteria to tempPersonArray
+		call this%c2%meetCriteria(temppersonArray, outPersonArray)
 	end subroutine meetAndCriteria
 
 	subroutine meetOrCriteria(this, personArray, outPersonArray)
@@ -107,11 +155,20 @@ subroutine meetOrCriteria(this, personArray, outPersonArray)
 		type(person), dimension (:), allocatable :: tempPersonArray2(:)
 		integer :: i, j
 		logical :: found = .false.
+
+		allocate(tempPersonArray1(1))
+		allocate(tempPersonArray2(1))
+
+		!Apply the two criterias separately
 		call this%c1%meetCriteria(personArray, tempPersonArray1)
-		call this%c1%meetCriteria(personArray, tempPersonArray2)
+		call this%c2%meetCriteria(personArray, tempPersonArray2)
 
+		if (.not. allocated(outPersonArray)) then
+			allocate(outPersonArray(1))
+		endif
+
 		do i = 1, size(tempPersonArray1), 1
-			outPersonArray(i) = tempPersonArray1(i)
+			call putInArray(outPersonArray, i, tempPersonArray1(i))
 		end do
 
 		do i = 1, size(tempPersonArray2), 1
@@ -122,10 +179,21 @@ subroutine meetOrCriteria(this, personArray, outPersonArray)
 					exit
 				endif
 			end do
-			if (found .eqv. .true.) then
-				outpersonArray(size(outpersonArray)+1) = tempPersonArray2(i)
+			if (found .eqv. .false.) then
+				call putInArray(outPersonArray, size(outpersonArray)+1, tempPersonArray2(i))
 			endif
 		end do
 	end subroutine meetOrCriteria
+
+	!Generalized method to print a person array
+	subroutine printPersonArray(personArray)
+		type(person), dimension (:), allocatable, intent(in) :: personArray(:)
+		integer :: i
+		do i = 1, size(personArray), 1
+			if (.not. personArray(i)%name .eq. '') then
+				print *, 'Name: '//personArray(i)%name//', Gender: '//personArray(i)%gender//', Marital Status: '//personArray(i)%maritalstatus
+			end if
+		end do
+	end subroutine printPersonArray
 
 end module criteria_module