The first sample listed below is a complete test case; the second example is the sub-program containing the source code that the test case uses.
Ensuring that DATECHK.CBL is in the same directory as the test case, compile MFUT_DATECHK.CBL to .dll (see Compiling Tests), then run the resulting test suite (see Running Tests). Two tests should pass; view MFUT_DATECHK-report.txt for more information.
$set case
$set nestcall ans85
copy "mfunit_prototypes.cpy".
****************************************************************
* *
* MFUT_DATECHK.CBL *
* *
* MFUT_DATECHK is a test program for the subprogram "DATECHK". *
* *
****************************************************************
identification division.
program-id. MFUT_DATECHK.
environment division.
configuration section.
data division.
working-storage section.
copy "mfunit.cpy".
01 input-date pic x(10).
01 output-date.
02 day-name pic xxx.
02 day-no pic xx.
02 month-name pic xxx.
02 year-no pic xxxx.
02 days-since-jan-1-1900 pic x(8).
01 tc-fail-count binary-long.
78 tc-usa value "U".
78 tc-uk value "E".
01 tc-msg-grp.
03 pic x(10) value "Test case ".
03 tc-count pic 999.
03 pic x(12) value " Failed -> ".
03 tc-msg pic x(40).
03 pic x value x"0".
procedure division.
move 0 to tc-count tc-fail-count
initialize output-date
move "13/01/2000" to input-date, tc-msg
call "datechk" using by reference input-date
by reference tc-usa
by reference output-date
end-call
perform expect-fail
initialize output-date
move "13/01/2000" to input-date, tc-msg
call "datechk" using by reference input-date
by reference tc-uk
by reference output-date
end-call
perform expect-pass
*>invalid year
initialize output-date
move "13/01/a000" to input-date, tc-msg
call "datechk" using by reference input-date
by reference tc-uk
by reference output-date
end-call
perform expect-fail
*>invalid month
initialize output-date
move "00/01/2000" to input-date, tc-msg
call "datechk" using by reference input-date
by reference tc-uk
by reference output-date
end-call
perform expect-fail
display "INFO: Test case count : " tc-count
display "INFO: Failed test case count : " tc-fail-count
goback returning tc-fail-count.
end-of-main section.
expect-pass section.
add 1 to tc-count
if day-name equal spaces
add 1 to tc-fail-count
perform dump-output-values
call MFU-ASSERT-FAIL-Z using
by reference tc-msg-grp
end-call
end-if
.
expect-fail section.
add 1 to tc-count
if day-name not equal spaces and
day-no not equal spaces
add 1 to tc-fail-count
perform dump-output-values
call MFU-ASSERT-FAIL-Z using
by reference tc-msg-grp
end-call
end-if.
dump-output-values section.
exhibit named tc-count input-date day-name
exhibit named day-no month-name year-no days-since-jan-1-1900
display "----------"
.
*> include the actual source code that we want to test.
copy "datechk.cbl".
end program MFUT_DATECHK.
program-id. datechk.
********************************************************
* This subprogram validates dates input in either *
* EUROPEAN or USA format. The result is returned *
* as day-name, day, month-name, year. *
* The program also calculates days since 1:1:1900 *
********************************************************
data division.
working-storage section.
01 days-in-month-table pic x(26)
value "31283130313031313031303129".
01 filler redefines days-in-month-table.
03 days-in-month pic 99 occurs 13.
01 month-name-table pic x(36)
value "JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC".
01 filler redefines month-name-table.
03 short-month-name pic xxx occurs 12.
01 day-names pic x(21)
value "MONTUEWEDTHUFRISATSUN".
01 filler redefines day-names.
03 day-of-the-week pic xxx occurs 7.
01 leap-year-indicator pic 9.
88 leap-year value 0.
01 subscript pic 99.
88 february value 2.
01 quotient pic 9999.
01 working-date.
03 work-day pic 99.
03 work-month pic 99.
03 work-year pic 9999.
01 julian-calculation.
03 days-to-1900 pic 9(8).
03 extra-leap-days pic 99.
03 days-to-date pic 9(8).
03 total-days pic 9(8).
03 current-date-integer pic 9(8).
01 end-of-19th-century pic 99999999.
linkage section.
01 input-date.
03 input-day-or-month pic 99.
03 filler pic x.
03 input-month-or-day pic 99.
03 filler pic x.
03 input-year pic 9999.
01 usa-or-uk pic x.
88 usa value "U".
88 uk value "E".
01 output-date.
02 day-name pic xxx.
02 day-no pic xx.
02 month-name pic xxx.
02 full-year-no.
03 cent-no pic xx.
03 year-no pic xx.
02 days-since-jan-1-1900 pic x(8).
procedure division using input-date, usa-or-uk, output-date.
date-check section.
prepare.
if uk move input-day-or-month to work-day
move input-month-or-day to work-month
else move "U" to usa-or-uk
move input-day-or-month to work-month
move input-month-or-day to work-day
end-if
move input-year to work-year.
move spaces to day-name
move 0 TO days-since-jan-1-1900 total-days
move work-day to day-no
move work-month to month-name
move work-year to full-year-no.
if input-year not numeric
move spaces to year-no
else
if work-year = 0
move 1 to leap-year-indicator
else
divide work-year by 4 giving quotient
remainder leap-year-indicator
end-if
if work-month is less than 1 or greater than 12
move spaces to month-name
else
move work-month to subscript
move short-month-name (subscript) to month-name
if leap-year and february
move 13 to subscript
end-if
if work-day is less than 1
or greater than days-in-month (subscript)
move spaces to day-no
else
perform calc-1900
end-if
end-if
end-if
exit program.
*Calculate days since start of century.
calc-1900 .
move input-year to current-date-integer(1:4)
move work-month to current-date-integer(5:2)
move work-day to current-date-integer(7:2)
move "18991231" to end-of-19th-century
compute days-to-date =
function integer-of-date(current-date-integer)
compute days-to-1900 =
function integer-of-date(end-of-19th-century)
subtract days-to-1900 from days-to-date giving total-days
move total-days to days-since-jan-1-1900
subtract 1 from total-days
divide total-days by 7 giving quotient remainder subscript.
add 1 to subscript.
move day-of-the-week (subscript) to day-name.
end program datechk.