! 
! File:          sort_SortTest_Impl.F90
! Symbol:        sort.SortTest-v0.1
! Symbol Type:   class
! Babel Version: 0.10.2
! Description:   Server-side implementation for sort.SortTest
! 
! WARNING: Automatically generated; only changes within splicers preserved
! 
! babel-version = 0.10.2
! 


! 
! Symbol "sort.SortTest" (version 0.1)
! 
! Run a bunch of sorts through a stress test.
! 


#include "sort_SortingAlgorithm_fAbbrev.h"
#include "sort_SortTest_fAbbrev.h"
#include "sidl_ClassInfo_fAbbrev.h"
#include "sidl_BaseInterface_fAbbrev.h"
#include "sidl_BaseClass_fAbbrev.h"
! DO-NOT-DELETE splicer.begin(_miscellaneous_code_start)
#include "sort_CompInt_fAbbrev.h"
#include "sort_Container_fAbbrev.h"
#include "sort_Counter_fAbbrev.h"
#include "sort_IntegerContainer_fAbbrev.h"

  recursive integer(selected_int_kind(9)) function intToString(ivalue, str)
  integer(selected_int_kind(9)), intent(in) :: ivalue
  integer(selected_int_kind(9)) :: copy
  integer(selected_int_kind(9)), parameter :: ten = 10
  character(len=*), intent(inout) :: str
  character(len=80) :: buffer
  logical :: isneg
  integer :: i, j, k
  i = 1
  copy = ivalue
  j = 1
  str = ''
  if (copy .lt. 0) then
     str(j:j) = '-'
     j = j + 1
     copy = -copy
  end if
  do 
     buffer(i:i) = char(ichar('0') + mod(copy,ten))
     i = i + 1
     copy = copy / 10
     if (copy .eq. 0) exit
  end do
! the string is done but reversed
  do k = 1, i-1
     str(j:j) = buffer(i - k:i - k)
     j = j + 1
  enddo
  intToString = j - 1
end function intToString


subroutine sortAndReport(alg, cont, comp)
  use sort_SortingAlgorithm
  use sort_Counter
  use sort_Container
  use sort_Comparator
  use synch_RegOut
  implicit none
  type(sort_SortingAlgorithm_t) :: alg
  type(sort_Container_t) :: cont
  type(sort_Comparator_t) :: comp
  type(sort_Counter_t) :: swpCnt, cmpCnt
  type(synch_RegOut_t) :: tracker
  integer(selected_int_kind(9)) numswap, numcmp
  character(len=80) :: cmpbuf, swapbuf
  integer(selected_int_kind(9)) :: cmplen, swaplen
  integer(selected_int_kind(9)) :: intToString
  call reset(alg)
  call sort(alg, cont, comp)
  call getSwapCounter(alg, swpCnt)
  call getCount(swpCnt, numswap)
  call deleteRef(swpCnt)
  call getCompareCounter(alg, cmpCnt)
  call getCount(cmpCnt, numcmp)
  call deleteRef(cmpCnt)
  cmplen = intToString(numcmp, cmpbuf)
  swaplen = intToString(numswap, swapbuf)
  call getInstance(tracker)
  call writeComment(tracker, 'compares (' // cmpbuf(1:cmplen) // &
       ') swaps (' // &
       swapbuf(1:swaplen) // ')')
  call deleteRef(tracker)
end subroutine sortAndReport

logical function notSorted(cont, comp)
  use sort_Container
  use sort_Comparator
  implicit none
  type(sort_Container_t) :: cont
  type(sort_Comparator_t) :: comp
  integer(selected_int_kind(9)) csize, i, result
  call getLength(cont, csize)
  do i = 1, csize - 1
     call compare(cont, i-1, i, comp, result)
     if (result .gt. 0) then
        notSorted = .true.
        goto 100
     endif
  enddo
  notSorted = .false.
100 return
end function notSorted

subroutine testAlgorithm(alg, retval)
  use sort_SortingAlgorithm
  use sort_IntegerContainer
  use sort_Container
  use sort_Comparator
  use sort_CompInt
  use synch_RegOut
  implicit none
  type(sort_SortingAlgorithm_t) :: alg
  type(sort_Container_t) :: cont
  type(sort_IntegerContainer_t) :: intcont
  type(sort_Comparator_t) :: comp
  type(sort_CompInt_t) ::intcomp
  type(synch_RegOut_t) :: tracker
  character(len=30) ::  name
  character(len=80) :: sizebuf
  integer(selected_int_kind(9)) :: sizelen, intToString
  logical notSorted, retval
  integer(selected_int_kind(9)) j, testsizes(10)
  data testsizes / 0, 1, 2, 3, 4, 7, 10, 51, 100, -1 /

  call getInstance(tracker)
  call getName(alg, name)
  call writeComment(tracker, &
       '****ALGORITHM IS ' // name // '****')
  call new(intcont)
  call cast(intcont, cont)
  call new(intcomp)
  call cast(intcomp, comp)
  j = 1
  do while (testsizes(j) .ge. 0)
     call setSortIncreasing(intcomp, .true.)
     sizelen = intToString(testsizes(j), sizebuf)
     call writeComment(tracker, &
          'DATA SIZE ' // sizebuf(1:sizelen))
     call setLength(intcont, testsizes(j))
     call sortAndReport(alg, cont, comp)
     if (notSorted(cont, comp)) then
        call writeComment(tracker, 'sort failed!!')
        retval = .false.
     endif
     call writeComment(tracker, 'pre-sorted list')
     call sortAndReport(alg, cont, comp)
     if (notSorted(cont, comp)) then
        call writeComment(tracker, 'sort failed!!')
        retval = .false.
     endif
     call writeComment(tracker, 'reverse sorted list')
     call setSortIncreasing(intcomp, .false.)
     call sortAndReport(alg, cont, comp)
     if (notSorted(cont, comp)) then
        call writeComment(tracker, 'sort failed!!')
        retval = .false.
     endif
     j = j + 1
  enddo

  call deleteRef(intcont)
  call deleteRef(alg)
  call deleteRef(intcomp)
  call deleteRef(tracker)
end subroutine testAlgorithm
! DO-NOT-DELETE splicer.end(_miscellaneous_code_start)




! 
! Class constructor called when the class is created.
! 

recursive subroutine sort_SortTest__ctor_mi(self)
  use sort_SortTest
  use sort_SortTest_impl
  ! DO-NOT-DELETE splicer.begin(sort.SortTest._ctor.use)
  ! Insert use statements here...
  ! DO-NOT-DELETE splicer.end(sort.SortTest._ctor.use)
  implicit none
  type(sort_SortTest_t) :: self ! in

! DO-NOT-DELETE splicer.begin(sort.SortTest._ctor)
! Insert the implementation here...
! DO-NOT-DELETE splicer.end(sort.SortTest._ctor)
end subroutine sort_SortTest__ctor_mi


! 
! Class destructor called when the class is deleted.
! 

recursive subroutine sort_SortTest__dtor_mi(self)
  use sort_SortTest
  use sort_SortTest_impl
  ! DO-NOT-DELETE splicer.begin(sort.SortTest._dtor.use)
  ! Insert use statements here...
  ! DO-NOT-DELETE splicer.end(sort.SortTest._dtor.use)
  implicit none
  type(sort_SortTest_t) :: self ! in

! DO-NOT-DELETE splicer.begin(sort.SortTest._dtor)
! Insert the implementation here...
! DO-NOT-DELETE splicer.end(sort.SortTest._dtor)
end subroutine sort_SortTest__dtor_mi


! 
! Static class initializer called exactly once before any user-defined method is dispatched
! 

recursive subroutine sort_SortTest__load_mi()
  use sort_SortTest
  use sort_SortTest_impl
  ! DO-NOT-DELETE splicer.begin(sort.SortTest._load.use)
  ! Insert use statements here...
  ! DO-NOT-DELETE splicer.end(sort.SortTest._load.use)
  implicit none

! DO-NOT-DELETE splicer.begin(sort.SortTest._load)
! Insert the implementation here...
! DO-NOT-DELETE splicer.end(sort.SortTest._load)
end subroutine sort_SortTest__load_mi


! 
! Perform the array stress test.
! 
! Return true if all the algorithms work okay.
! 

recursive subroutine sort_SortTest_stressTest_mi(algs, retval)
  use sort_SortTest
  use sort_SortingAlgorithm
  use sort_SortingAlgorithm_array
  use sort_SortTest_impl
  ! DO-NOT-DELETE splicer.begin(sort.SortTest.stressTest.use)
  ! Insert use statements here...
  ! DO-NOT-DELETE splicer.end(sort.SortTest.stressTest.use)
  implicit none
  type(sort_SortingAlgorithm_1d) :: algs ! in
  logical :: retval ! out

! DO-NOT-DELETE splicer.begin(sort.SortTest.stressTest)
  integer(selected_int_kind(9)) low, up, i
  type(sort_SortingAlgorithm_t) ::alg
  if (not_null(algs)) then
     low = lower(algs, 0)
     up = upper(algs, 0)
     retval = .true.
     do i = low, up
        call get(algs, i, alg)
        if (not_null(alg)) then
           call testAlgorithm(alg, retval)
        else
           retval = .false.
        endif
     enddo
  endif
! DO-NOT-DELETE splicer.end(sort.SortTest.stressTest)
end subroutine sort_SortTest_stressTest_mi


! DO-NOT-DELETE splicer.begin(_miscellaneous_code_end)
! Insert extra code here...
! DO-NOT-DELETE splicer.end(_miscellaneous_code_end)