diff --git a/README.md b/README.md index 3832a20..4135831 100644 --- a/README.md +++ b/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 diff --git a/structural/criteria/criteria_main b/structural/criteria/criteria_main index 403fe49..9efbf5e 100755 Binary files a/structural/criteria/criteria_main and b/structural/criteria/criteria_main differ diff --git a/structural/criteria/criteria_main.f90 b/structural/criteria/criteria_main.f90 index bb1232a..784178f 100644 --- a/structural/criteria/criteria_main.f90 +++ b/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 \ No newline at end of file diff --git a/structural/criteria/criteria_module.f90 b/structural/criteria/criteria_module.f90 index 96cd245..ad90963 100644 --- a/structural/criteria/criteria_module.f90 +++ b/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 \ No newline at end of file