Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
Futility
Futility
Commits
a6761ed9
Commit
a6761ed9
authored
Oct 21, 2021
by
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
Changes
5
Pipelines
1
Expand all
Hide whitespace changes
Inline
Side-by-side
src/FutilityComputingEnvironment.f90
View file @
a6761ed9
...
...
@@ -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
...
...
src/Times.f90
View file @
a6761ed9
This diff is collapsed.
Click to expand it.
unit_tests/testFileType_Log/testFileType_Log.f90
View file @
a6761ed9
...
...
@@ -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
!
...
...
unit_tests/testFutilityComputingEnvironment/testFutilityComputingEnvironment.f90
View file @
a6761ed9
...
...
@@ -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
()
...
...
unit_tests/testTimes/testTimes.f90
View file @
a6761ed9
...
...
@@ -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
)
testTimes
Submodule
#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'
)