Commit a6761ed9 authored by Graham, Aaron's avatar Graham, Aaron
Browse files

Merge branch 'timer_updates' into 'master'

Timer updates

See merge request futility/Futility!352
parents 866a7131 9699ad0c
Pipeline #170064 passed with stage
in 2 minutes and 7 seconds
......@@ -95,6 +95,8 @@ TYPE :: FutilityComputingEnvironment
PROCEDURE,PASS :: clearSubCompEnvs
ENDTYPE FutilityComputingEnvironment
CHARACTER(LEN=*),PARAMETER :: modName='FutilityComputingEnvironmentModule'
!===============================================================================
CONTAINS
!
......@@ -135,13 +137,22 @@ FUNCTION addTimer(this,name) RESULT(timer)
CHARACTER(LEN=*),INTENT(IN) :: name
CLASS(TimerType),POINTER :: timer
!
CHARACTER(LEN=*),PARAMETER :: myName='addTimer'
INTEGER(SIK) :: iTimer
TYPE(StringType) :: timername
TYPE(StringType),ALLOCATABLE :: timernames(:)
TYPE(TimerPtrArray),ALLOCATABLE :: oldTimers(:)
REQUIRE(LEN_TRIM(name) > 0)
timername=name
timernames=timername%split('->')
DO iTimer=1,SIZE(timernames)
timernames(iTimer)=TRIM(ADJUSTL(timernames(iTimer)))
ENDDO
!Check to see if a timer of this name already exists. If so, return it
timer => this%getTimer(name)
timer => this%getTimer(CHAR(timernames(1)))
!If no timer was found, create it and return a pointer
IF(.NOT.ASSOCIATED(timer)) THEN
......@@ -162,14 +173,32 @@ FUNCTION addTimer(this,name) RESULT(timer)
!Now add the new timer
this%nTimers=this%nTimers+1
ALLOCATE(this%timers(this%nTimers)%t)
CALL this%timers(this%nTimers)%t%setTimerHiResMode(.TRUE.)
CALL this%timers(this%nTimers)%t%setTimerName(TRIM(name))
timer => this%timers(this%nTimers)%t
IF(SIZE(timernames) > 1) THEN
ALLOCATE(ParentTimerType :: this%timers(this%nTimers)%t)
CALL this%timers(this%nTimers)%t%setTimerHiResMode(.TRUE.)
CALL this%timers(this%nTimers)%t%setTimerName(TRIM(timernames(1)))
SELECTTYPE(t => this%timers(this%nTimers)%t); TYPE IS(ParentTimerType)
CALL t%addTimer(TRIM(ADJUSTL(timername%substr(INDEX(timername,'->')+2))))
timer => t%getTimer(TRIM(ADJUSTL(timername%substr(INDEX(timername,'->')+2))))
ENDSELECT
ELSE
ALLOCATE(this%timers(this%nTimers)%t)
CALL this%timers(this%nTimers)%t%setTimerHiResMode(.TRUE.)
CALL this%timers(this%nTimers)%t%setTimerName(TRIM(timernames(1)))
timer => this%timers(this%nTimers)%t
ENDIF
ELSEIF(SIZE(timernames) > 1) THEN
SELECTTYPE(t => timer)
TYPE IS(ParentTimerType)
CALL t%addTimer(TRIM(ADJUSTL(timername%substr(INDEX(timername,'->')+2))))
timer => t%getTimer(TRIM(ADJUSTL(timername%substr(INDEX(timername,'->')+2))))
TYPE IS(TimerType)
CALL this%exceptHandler%raiseError(modName//'::'//myName// &
' - Timer "'//timernames(1)//'" is not a parent timer so "'//name//'" cannot be added!')
timer => NULL()
ENDSELECT
ENDIF
ENSURE(ASSOCIATED(timer))
ENDFUNCTION addTimer
!
!-------------------------------------------------------------------------------
......@@ -185,10 +214,17 @@ SUBROUTINE removeTimer(this,name)
CLASS(FutilityComputingEnvironment),INTENT(INOUT) :: this
CHARACTER(LEN=*),INTENT(IN) :: name
!
CHARACTER(LEN=*),PARAMETER :: myName='removeTimer'
INTEGER(SIK) :: iTimer
CLASS(TimerType),POINTER :: timer
TYPE(TimerPtrArray),ALLOCATABLE :: oldTimers(:)
IF(INDEX(name,'->') > 0) THEN
CALL this%exceptHandler%raiseError(modName//'::'//myName// &
' - Cannot remove individual subtimers! Remove the parent timer '// &
'instead of removing "'//name//'"!')
RETURN
ENDIF
timer => this%getTimer(name)
IF(ASSOCIATED(timer)) THEN
......@@ -227,12 +263,31 @@ FUNCTION getTimer(this,name) RESULT(timer)
CHARACTER(LEN=*),INTENT(IN) :: name
CLASS(TimerType),POINTER :: timer
!
CHARACTER(LEN=*),PARAMETER :: myName='getTimer'
INTEGER(SIK) :: iTimer
TYPE(StringType) :: timername
TYPE(StringType),ALLOCATABLE :: timernames(:)
timername=name
timernames=timername%split('->')
DO iTimer=1,SIZE(timernames)
timernames(iTimer)=TRIM(ADJUSTL(timernames(iTimer)))
ENDDO !iTimer
timer => NULL()
DO iTimer=1,this%nTimers
IF(TRIM(name) == this%timers(iTimer)%t%getTimerName()) THEN
IF(TRIM(timernames(1)) == this%timers(iTimer)%t%getTimerName()) THEN
timer => this%timers(iTimer)%t
IF(SIZE(timernames) > 1) THEN
SELECTTYPE(t => timer)
TYPE IS(TimerType)
CALL this%exceptHandler%raiseError(modName//'::'//myName// &
' - cannot retrieve subtimer "'//name//'" from timer "'//timer%getTimerName()//'"!')
timer => NULL()
TYPE IS(ParentTimerType)
timer => t%getTimer(TRIM(ADJUSTL(timername%substr(INDEX(timername,'->')+2))))
ENDSELECT
ENDIF
EXIT
ENDIF
ENDDO !iTimer
......
This diff is collapsed.
......@@ -50,8 +50,7 @@ SUBROUTINE testLogFileType()
CALL testFile%initialize(UNIT=66,FILE='./test.log',STATUS='OLD',ACTION='READ')
CALL testFile%fopen()
READ(66,'(a)') string
bool=(TRIM(string(12:LEN(string))) == ' Passed: CALL testLogFile%message(...)')
ASSERT(bool,'%message(...)')
ASSERT_EQ(TRIM(string(12:LEN(string))),'Passed: CALL testLogFile%message(...)','%message(...)')
CALL testFile%clear(.TRUE.)
ENDSUBROUTINE testLogFileType
!
......
......@@ -34,6 +34,9 @@ TYPE(FutilityComputingEnvironment) :: testCompEnv
CREATE_TEST('FutilityComputingEnvironment')
testCompEnv%exceptHandler => exceptHandler
CALL exceptHandler%setStopOnError(.FALSE.)
REGISTER_SUBTEST('Timers',testTimers)
REGISTER_SUBTEST('Sub-environments',testSubEnvs)
REGISTER_SUBTEST('clear',testClear)
......@@ -46,7 +49,7 @@ CONTAINS
!
!-------------------------------------------------------------------------------
SUBROUTINE testTimers()
CLASS(TimerType),POINTER :: timer
CLASS(TimerType),POINTER :: timer,timer2
COMPONENT_TEST('addTimer')
ASSERT_EQ(testCompEnv%nTimers,0,'%nTimers')
......@@ -59,6 +62,28 @@ SUBROUTINE testTimers()
timer => testCompEnv%addTimer('timer3')
ASSERT_EQ(testCompEnv%nTimers,3,'%nTimers')
ASSERT(ASSOCIATED(timer),'%addTimer')
timer => testCompEnv%addTimer('timer4 -> subtimer')
ASSERT_EQ(testCompEnv%nTimers,4,'%nTimers')
ASSERT(ASSOCIATED(timer),'%addTimer')
SELECTTYPE(timer)
TYPE IS(TimerType)
ASSERT(.TRUE.,'timer type')
ASSERT_EQ(timer%getTimerName(),'subtimer','timer name')
CLASS DEFAULT
ASSERT(.FALSE.,'timer type')
ENDSELECT
timer => testCompEnv%addTimer('timer4 -> subtimer2 -> subsubtimer')
ASSERT_EQ(testcompEnv%nTimers,4,'%nTimers')
ASSERT(ASSOCIATED(timer),'%addTimer')
SELECTTYPE(timer)
TYPE IS(TimerType)
ASSERT(.TRUE.,'timer type')
ASSERT_EQ(timer%getTimerName(),'subsubtimer','timer name')
CLASS DEFAULT
ASSERT(.FALSE.,'timer type')
ENDSELECT
timer => testCompEnv%addTimer('timer1 -> subtimer')
ASSERT(.NOT.ASSOCIATED(timer),'bad %addTimer')
COMPONENT_TEST('getTimer')
timer => testCompEnv%getTimer('timer1')
......@@ -67,12 +92,54 @@ SUBROUTINE testTimers()
ASSERT(ASSOCIATED(timer),'%getTimer')
timer => testCompEnv%getTimer('timer3')
ASSERT(ASSOCIATED(timer),'%getTimer')
timer => testCompEnv%getTimer('timer4')
ASSERT(ASSOCIATED(timer),'%getTimer')
SELECTTYPE(timer)
TYPE IS(ParentTimerType)
ASSERT(.TRUE.,'parent timer type')
timer2 => timer%getTimer('subtimer')
ASSERT(ASSOCIATED(timer2),'getting subtimer')
CLASS DEFAULT
ASSERT(.FALSE.,'parent timer type')
ENDSELECT
timer => testCompEnv%getTimer('timer4 -> subtimer')
ASSERT(ASSOCIATED(timer),'%getTimer')
SELECTTYPE(timer)
TYPE IS(TimerType)
ASSERT(.TRUE.,'timer type')
ASSERT_EQ(timer%getTimerName(),'subtimer','timer name')
CLASS DEFAULT
ASSERT(.FALSE.,'timer type')
ENDSELECT
timer => testCompEnv%getTimer('timer4 -> subtimer2 -> subsubtimer')
ASSERT(ASSOCIATED(timer),'%getTimer')
SELECTTYPE(timer)
TYPE IS(TimerType)
ASSERT(.TRUE.,'timer type')
ASSERT_EQ(timer%getTimerName(),'subsubtimer','timer name')
CLASS DEFAULT
ASSERT(.FALSE.,'timer type')
ENDSELECT
timer => testCompEnv%getTimer('timer1 -> subtimer')
ASSERT(.NOT.ASSOCIATED(timer),'%getTimer')
timer => testCompEnv%getTimer('timer5')
ASSERT(.NOT.ASSOCIATED(timer),'%getTimer')
COMPONENT_TEST('removeTimer')
CALL testCompEnv%removeTimer('timer2')
ASSERT_EQ(testCompEnv%nTimers,2,'%nTimers')
ASSERT_EQ(testCompEnv%nTimers,3,'%nTimers')
timer => testCompEnv%getTimer('timer2')
ASSERT(.NOT.ASSOCIATED(timer),'%removeTimer')
CALL testCompEnv%removeTimer('timer4 -> subtimer')
ASSERT_EQ(testCompEnv%nTimers,3,'%nTimers')
timer => testCompEnv%getTimer('timer4 -> subtimer')
ASSERT(ASSOCIATED(timer),'ASSOCIATED subtimer')
CALL testCompEnv%removeTimer('timer4')
ASSERT_EQ(testCompEnv%nTimers,2,'%nTimers')
timer => testCompEnv%getTimer('timer4 -> subtimer')
ASSERT(.NOT.ASSOCIATED(timer),'ASSOCIATED subtimer')
timer => testCompEnv%getTimer('timer4')
ASSERT(.NOT.ASSOCIATED(timer),'ASSOCIATED subtimer')
COMPONENT_TEST('clearTimers')
CALL testCompEnv%clearTimers()
......
......@@ -6,7 +6,7 @@
! of Michigan and Oak Ridge National Laboratory.  The copyright and license !
! can be found in LICENSE.txt in the head directory of this repository.   !
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++!
PROGRAM testTimes
SUBMODULE(Times) testTimesSubmodule
#include "UnitTest.h"
USE UnitTest
USE IntrType
......@@ -24,169 +24,315 @@ CHARACTER(LEN=MAXLEN_DATE_STRING) :: adate
CHARACTER(LEN=MAXLEN_CLOCK_STRING) :: aclock
REAL(SRK) :: totalElapsed
!
!Check the timer resolution
CREATE_TEST('TIMERS')
!===============================================================================
CONTAINS
!
!-------------------------------------------------------------------------------
SUBROUTINE runTestTimes()
CREATE_TEST('Timers')
REGISTER_SUBTEST('Basic Timers',testTimers)
REGISTER_SUBTEST('Parent Timers',testParentTimers)
FINALIZE_TEST()
ENDSUBROUTINE runTestTimes
!
!-------------------------------------------------------------------------------
SUBROUTINE testTimers()
COMPONENT_TEST('getDate()')
!
!Test getDate()
adate=getDate()
idum1=0
idum2=0
idum3=0
READ(adate,'(i2,a1,i2,a1,i4)',iostat=ioerr) idum1,adum1,idum2,adum2,idum3
ASSERT_EQ(ioerr,0,'ioerr')
ASSERT_GT(idum1,0,'month')
ASSERT_LT(idum1,13,'month')
ASSERT_GT(idum2,0,'day')
ASSERT_LT(idum2,32,'day')
ASSERT_GT(idum3,0,'year')
ASSERT_EQ(adum1,adum2,'adum')
ASSERT_EQ(adum1,'/','adum1')
INFO(0) 'getDate() = '//getDate()
ASSERT_EQ(getDate(),getDate(1),'getDate(1)')
idum1=0
idum2=0
adate=getDate(2)
READ(adate,'(a5,i2,a2,i4)',iostat=ioerr) adum3,idum1,adum4,idum2
ASSERT_EQ(ioerr,0,'ioerr')
ASSERT_GT(idum1,0,'day')
ASSERT_LT(idum1,32,'day')
ASSERT_GT(idum2,0,'year')
ASSERT_EQ(adum4(1:1),',','month')
!Test getTimeFromDate
COMPONENT_TEST('getTimeFromDate')
ASSERT_APPROXEQA(getTimeFromDate('12/01/1990','12/02/1990'),1.0_SRK,'check Defaults')
ASSERT_APPROXEQA(getTimeFromDate('12/1/1990','12/2/1990','HOUR'),24.0_SRK,'check HOUR and MM/D/YYYY fmt')
ASSERT_APPROXEQA(getTimeFromDate('1/1/1990','1/2/1990','MIN'),1440.0_SRK,'check MIN and M/D/YYYY fmt')
ASSERT_APPROXEQA(getTimeFromDate('1/10/1990','1/11/1990','SEC'),86400.0_SRK,'check SEC and M/DD/YYYY fmt')
ASSERT_APPROXEQA(getTimeFromDate('1990/12/01','1994/12/01','DAY'),1461.0_SRK,'check DAY, YYYY/MM/DD fmt and leapyear calls')
ASSERT_APPROXEQA(getTimeFromDate('1990/12/1','1998/12/1','DAY'),2922.0_SRK,'check DAY, YYYY/MM/D fmt and leapyear calls')
ASSERT_APPROXEQA(getTimeFromDate('1990/1/01','2002/1/01','DAY'),4383.0_SRK,'check DAY, YYYY/M/DD fmt and leapyear calls')
ASSERT_APPROXEQA(getTimeFromDate('1890/1/1','1906/1/1','DAY'),5843.0_SRK,'check DAY, YYYY/M/D fmt and leapyear calls')
ASSERT_APPROXEQA(getTimeFromDate('09/05/1997','10/05/1997','SEC'),2592000.0_SRK,'check SEC 09/05/1997 and 10/05/1997')
ASSERT_APPROXEQA(getTimeFromDate('9/20/2009','10/19/2009','HOUR'),696.0_SRK,'check HOUR 9/20/2009 and 10/19/2009')
!Test getClockTime
COMPONENT_TEST('getClockTime()')
idum1=0
idum2=0
idum3=0
aclock=getClockTime()
READ(aclock,'(i2,a1,i2,a1,i2)',iostat=ioerr) idum1,adum1,idum2,adum2,idum3
ASSERT_EQ(ioerr,0,'ioerr')
ASSERT_GT(idum1,-1,'hour')
ASSERT_LT(idum1,24,'hour')
ASSERT_GT(idum2,-1,'minute')
ASSERT_LT(idum2,60,'minute')
ASSERT_GT(idum3,-1,'minute')
ASSERT_LT(idum3,60,'minute')
ASSERT_EQ(adum1,':',':')
ASSERT_EQ(adum1,adum2,':')
COMPONENT_TEST('HI-RES TIMER')
ASSERT_EQ(LEN_TRIM(testTimer%getTimerName()),0,'%getTimerName()')
CALL testTimer%setTimerName('myName')
ASSERT_EQ(TRIM(testTimer%getTimerName()),'myName','%setTimerName()')
testTimer%elapsedtime=0.0001_SRK
ASSERT_EQ(testTimer%getTimeReal(),0.0001_SRK,'%getTimeReal()')
ASSERT_EQ(testTimer%getTimeChar(),' 100.000 microsec','%getTimeChar() (us)')
ASSERT_EQ(testTimer%getTimeHHMMSS(),'00:00.00 ','%getTimeHHMMSS() (us)')
testTimer%elapsedtime=0.999_SRK
ASSERT_EQ(testTimer%getTimeChar(),' 999.000 ms ','%getTimeChar() (ms)')
ASSERT_EQ(testTimer%getTimeHHMMSS(),'00:01.00 ','%getTimeHHMMSS() (ms)')
testTimer%elapsedtime=100.637_SRK
ASSERT_EQ(testTimer%getTimeChar(),' 100.637 s ','%getTimeChar() (s)')
ASSERT_EQ(testTimer%getTimeHHMMSS(),'01:40.64 ','%getTimeHHMMSS() (s)')
testTimer%elapsedtime=100000.6_SRK
ASSERT_EQ(testTimer%getTimeChar(),'27:46:40.60 hh:mm:ss','%getTimeChar() (hr)')
ASSERT_EQ(testTimer%getTimeHHMMSS(),'27:46:40.60','%getTimeHHMMSS() (hr)')
testTimer%elapsedtime=3719.6_SRK
ASSERT_EQ(testTimer%getTimeHHMMSS(),'01:01:59.60','%getTimeHHMMSS() (round)')
CALL testTimer%ResetTimer()
ASSERT_EQ(LEN_TRIM(testTimer%getTimername()),0,'name')
ASSERT_EQ(testTimer%elapsedtime,0._SRK,'elapsedtime')
ASSERT_EQ(testTimer%getTimeChar(),' 0.000 microsec','time char')
CALL testTimer%tic()
CALL sleep(1)
CALL testTimer%toc()
totalElapsed=testTimer%elapsedtime
ASSERT_GT(totalElapsed,0.0_SRK,'tic/toc')
CALL testTimer%tic()
CALL sleep(1)
CALL testTimer%toc()
ASSERT_GT(testTimer%elapsedtime,totalElapsed,'tic/toc')
totalElapsed=testTimer%elapsedtime
CALL testTimer%tic()
CALL sleep(1)
CALL testTimer%toc()
ASSERT_GT(testTimer%elapsedtime,totalElapsed,'tic/toc')
totalElapsed=testTimer%elapsedtime
ASSERT_LT(totalElapsed,60.0_SRK,'tic/toc too slow')
ASSERT(testTimer%getTimerHiResMode(),'%getTimerHiResMode()')
COMPONENT_TEST('LO-RES TIMER')
CALL testTimer%setTimerHiResMode(.FALSE.)
ASSERT(.NOT.testTimer%getTimerHiResMode(),'%getTimerHiResMode()')
adate=testTimer%getDate()
idum1=0
idum2=0
idum3=0
READ(adate,'(i2,a1,i2,a1,i4)',iostat=ioerr) idum1,adum1,idum2,adum2,idum3
ASSERT_EQ(ioerr,0,'ioerr')
ASSERT_GT(idum1,0,'month')
ASSERT_LT(idum1,13,'month')
ASSERT_GT(idum2,0,'day')
ASSERT_LT(idum2,32,'day')
ASSERT_GT(idum3,0,'year')
ASSERT_EQ(adum1,adum2,'adum')
ASSERT_EQ(adum1,'/','adum1')
ASSERT_EQ(testTimer%getDate(),testTimer%getDate(1),'%getDate(1)')
idum1=0
idum2=0
adate=testTimer%getDate(2)
READ(adate,'(a5,i2,a2,i4)',iostat=ioerr) adum3,idum1,adum4,idum2
ASSERT_EQ(ioerr,0,'ioerr')
ASSERT_GT(idum1,0,'day')
ASSERT_LT(idum1,32,'day')
ASSERT(idum2 > 0,'year')
ASSERT_EQ(adum4(1:1),',','month')
idum1=0
idum2=0
idum3=0
aclock=testTimer%getClockTime()
READ(aclock,'(i2,a1,i2,a1,i2)',iostat=ioerr) idum1,adum1,idum2,adum2,idum3
ASSERT_EQ(ioerr,0,'ioerr')
ASSERT_GT(idum1,-1,'hour')
ASSERT_LT(idum1,24,'hour')
ASSERT_GT(idum2,-1,'minute')
ASSERT_LT(idum2,60,'minute')
ASSERT_GT(idum3,-1,'minute')
ASSERT_LT(idum3,60,'minute')
ASSERT_EQ(adum1,':',':')
ASSERT_EQ(adum1,adum2,':')
testTimer%elapsedtime=0.0001_SRK
COMPONENT_TEST('testTimer%getRemainingTime')
CALL testTimer%tic()
CALL sleep(1)
CALL testTimer%toc()
totalElapsed=testTimer%elapsedtime
ASSERT_GT(totalElapsed,0.0_SRK,'tic/toc')
CALL testTimer%tic()
CALL sleep(1)
CALL testTimer%toc()
ASSERT_GT(testTimer%elapsedtime,totalElapsed,'tic/toc')
totalElapsed=testTimer%elapsedtime
CALL testTimer%tic()
CALL sleep(1)
CALL testTimer%toc()
ASSERT_GT(testTimer%elapsedtime,totalElapsed,'tic/toc')
totalElapsed=testTimer%elapsedtime
ASSERT_LT(totalElapsed,60.0_SRK,'tic/toc too slow')
ENDSUBROUTINE testTimers
!
!-------------------------------------------------------------------------------
SUBROUTINE testParentTimers()
TYPE(ParentTimerType) :: parentTimer
TYPE(TimerType),POINTER :: tmpptr
CLASS(TimerType),POINTER :: timerptr
COMPONENT_TEST('clear')
CALL parentTimer%clear()
ALLOCATE(parentTimer%timers(1))
!Doing this tmpptr thing because of what seems like a compiler bug. Allocating
!timers(1)%t directly causes a segfault unless I have a WRITE statement first.
!It only happens in this test, not elsewhere
tmpptr => NULL()
ALLOCATE(tmpptr)
parentTimer%timers(1)%t => tmpptr
parentTimer%name='testName'
CALL parentTimer%clear()
ASSERT(.NOT.ALLOCATED(parentTimer%timers),'ALLOCATED %timers')
ASSERT_EQ(parentTimer%getTimerName(),'','%name')
COMPONENT_TEST('addTimer')
CALL parentTimer%addTimer('test1')
ASSERT_EQ(SIZE(parentTimer%timers),1,'SIZE %timers')
SELECTTYPE(t => parentTimer%timers(1)%t)
TYPE IS(TimerType)
ASSERT(.TRUE.,'timer(1) type')
CLASS DEFAULT
ASSERT(.FALSE.,'timer(1) type')
ENDSELECT
CALL parentTimer%addTimer('test2')
ASSERT_EQ(SIZE(parentTimer%timers),2,'SIZE %timers')
SELECTTYPE(t => parentTimer%timers(2)%t)
TYPE IS(TimerType)
ASSERT(.TRUE.,'timer(2) type')
CLASS DEFAULT
ASSERT(.FALSE.,'timer(2) type')
ENDSELECT
CALL parentTimer%addTimer('test3 -> subtest1')
ASSERT_EQ(SIZE(parentTimer%timers),3,'SIZE %timers')
SELECTTYPE(t => parentTimer%timers(3)%t)
TYPE IS(ParentTimerType)
ASSERT(.TRUE.,'timer(3) type')
ASSERT_EQ(SIZE(t%timers),1,'SIZE %timers(3)%timers')
CLASS DEFAULT
ASSERT(.FALSE.,'timer(3) type')
ENDSELECT
CALL parentTimer%addTimer('test4 -> subtest2')
ASSERT_EQ(SIZE(parentTimer%timers),4,'SIZE %timers')
SELECTTYPE(t => parentTimer%timers(4)%t)
TYPE IS(ParentTimerType)
ASSERT(.TRUE.,'timer(4) type')
ASSERT_EQ(SIZE(t%timers),1,'SIZE %timers(4)%timers')
CLASS DEFAULT
ASSERT(.FALSE.,'timer(4) type')
ENDSELECT
CALL parentTimer%addTimer('subtest1')
ASSERT_EQ(SIZE(parentTimer%timers),5,'SIZE %timers')
SELECTTYPE(t => parentTimer%timers(1)%t)
TYPE IS(TimerType)
ASSERT(.TRUE.,'timer(5) type')
CLASS DEFAULT
ASSERT(.FALSE.,'timer(5) type')
ENDSELECT
CALL parentTimer%addTimer('test4 -> subtest1')
ASSERT_EQ(SIZE(parentTimer%timers),5,'SIZE %timers')
SELECTTYPE(t => parentTimer%timers(4)%t)
TYPE IS(ParentTimerType)
ASSERT(.TRUE.,'timer(4) type')
ASSERT_EQ(SIZE(t%timers),2,'SIZE %timers(4)%timers')
CLASS DEFAULT
ASSERT(.FALSE.,'timer(4) type')
ENDSELECT
CALL parentTimer%addTimer('test4 -> test1')
ASSERT_EQ(SIZE(parentTimer%timers),5,'SIZE %timers')
SELECTTYPE(t => parentTimer%timers(4)%t)
TYPE IS(ParentTimerType)
ASSERT(.TRUE.,'timer(4) type')
ASSERT_EQ(SIZE(t%timers),3,'SIZE %timers(4)%timers')
CLASS DEFAULT
ASSERT(.FALSE.,'timer(4) type')
ENDSELECT
CALL parentTimer%addTimer('test2')
ASSERT_EQ(SIZE(parentTimer%timers),5,'SIZE %timers')
CALL parentTimer%addTimer('test4 -> test1')
ASSERT_EQ(SIZE(parentTimer%timers),5,'SIZE %timers')
SELECTTYPE(t => parentTimer%timers(4)%t)
TYPE IS(ParentTimerType)
ASSERT(.TRUE.,'timer(4) type')
ASSERT_EQ(SIZE(t%timers),3,'SIZE %timers(4)%timers')
CLASS DEFAULT
ASSERT(.FALSE.,'timer(4) type')
ENDSELECT
COMPONENT_TEST('getDate()')
COMPONENT_TEST('getTimer')
timerptr => parentTimer%getTimer('test1')
ASSERT(ASSOCIATED(timerptr),'ASSOCIATED %getTimer("test1")')
ASSERT_EQ(CHAR(timerptr%name),'test1','getTimer("test1")')
timerptr => parentTimer%getTimer('test2')
ASSERT(ASSOCIATED(timerptr),'ASSOCIATED %getTimer("test2")')
ASSERT_EQ(CHAR(timerptr%name),'test2','getTimer("test2")')
timerptr => parentTimer%getTimer('test3 -> subtest1')
ASSERT(ASSOCIATED(timerptr),'ASSOCIATED %getTimer("test3 -> subtest1")')
ASSERT_EQ(CHAR(timerptr%name),'subtest1','getTimer("test3 -> subtest1")')
timerptr => parentTimer%getTimer('test4 -> subtest2')
ASSERT(ASSOCIATED(timerptr),'ASSOCIATED %getTimer("test4 -> subtest1")')
ASSERT_EQ(CHAR(timerptr%name),'subtest2','getTimer("test4 -> subtest2")')
timerptr => parentTimer%getTimer('subtest1')
ASSERT(ASSOCIATED(timerptr),'ASSOCIATED %getTimer("subtest1")')
ASSERT_EQ(CHAR(timerptr%name),'subtest1','getTimer("subtest1")')
timerptr => parentTimer%getTimer('test4 -> subtest1')
ASSERT(ASSOCIATED(timerptr),'ASSOCIATED %getTimer("test4 -> subtest1")')
ASSERT_EQ(CHAR(timerptr%name),'subtest1','getTimer("test4 -> subtest1")')
timerptr => parentTimer%getTimer('test4 -> test1')
ASSERT(ASSOCIATED(timerptr),'ASSOCIATED %getTimer("test4 -> test1")')
ASSERT_EQ(CHAR(timerptr%name),'test1','getTimer("test4 -> test1")')
timerptr => parentTimer%getTimer('subtest2')
ASSERT(.NOT.ASSOCIATED(timerptr),'ASSOCIATED %getTimer("subtest2")')
timerptr => parentTimer%getTimer('test4 -> subtest1')
ASSERT(ASSOCIATED(timerptr),'ASSOCIATED %getTimer("test4 -> subtest1")')
ASSERT_EQ(CHAR(timerptr%name),'subtest1','getTimer("test4 -> subtest1")')
timerptr => parentTimer%getTimer('test')
ASSERT(.NOT.ASSOCIATED(timerptr),'ASSOCIATED %getTimer("test")')
ENDSUBROUTINE testParentTimers
!
!Test getDate()
adate=getDate()
idum1=0
idum2=0
idum3=0
READ(adate,'(i2,a1,i2,a1,i4)',iostat=ioerr) idum1,adum1,idum2,adum2,idum3
ASSERT_EQ(ioerr,0,'ioerr')
ASSERT_GT(idum1,0,'month')
ASSERT_LT(idum1,13,'month')
ASSERT_GT(idum2,0,'day')