Example Test Programs
RPG
Below is an example RPG free-format program utilizing the various MDTest Helper Functions
**Free
//***************************************************
//Compile Settings *
//***************************************************
Ctl-Opt Alloc(*Teraspace) Option(*SrcStmt:*NoDebugIO:*NoUnRef)
Main(mainProc);
//***************************************************
//Copybooks *
//***************************************************
/Copy QRPGLESRC,MDRTESTP
//***************************************************
//Global Variables & Data Structures *
//***************************************************
//***************************************************
//Main Procedure - *ENTRY *
//***************************************************
Dcl-Proc mainProc;
Dcl-Pi mainProc;
CmdDur Zoned(6);
SQLDur Zoned(6);
End-Pi;
Dcl-DS d_SQLRow Qualified Dim(100);
CurCod Char(3);
Act_FX Packed(8:3);
Exp_FX Packed(8:3);
End-DS;
Dcl-S Cnt Packed(3);
Dcl-S Date Char(8);
Dcl-S Status Like(MDTest_reg_CodeCov_Mod);
Dcl-S Cmd VarChar(2048);
Dcl-S Elem VarChar(256) Dim(50);
Dcl-S Row Int(10);
Dcl-S i Int(10);
Dcl-C c_Quote Const('''');
//register application program for code coverage
Status = MDTest_reg_CodeCov_Mod('*LIBL':
'MDACURUPD':
'*ALL':
'*PGM':
50:
*Omit:
15:
*Omit:
'FINANCE');
If Status = MDTest_FAIL;
Return;
EndIf;
//invoke currency update process
Date = %char(%date():*ISO0);
Cmd = 'CALL PGM(MDACURUPD) PARM(' + c_Quote +
Date + c_Quote + ')';
Status = MDTest_Execute_CMD(Cmd:
10:
CmdDur:
'Currency update process');
If Status = MDTest_FAIL;
Return;
EndIf;
//generate code coverage report
MDTest_rpt_CodeCov('code coverage for currency update pgm');
Cmd = 'UPDATE MDTEST_COMPARE_RATES A ' +
'SET A.CHF_FX = (RRN(A) / 10) + 1';
Status = MDTest_Execute_SQL(Cmd:
10:
SQLDur:
'Generate Test Values');
If Status = MDTest_FAIL;
Return;
EndIf;
MDTest_addInfo('various tests using the test table');
Exec SQL
DECLARE C1 CURSOR FOR
SELECT A.CURCOD, A.VALCHF, E.CHF_FX
FROM MDACUR A, MDTEST_COMPARE_RATES E
WHERE A.CURCOD = E.CURCOD
ORDER BY A.CURCOD;
Exec SQL
Open C1;
DoW 1 = 1;
Exec SQL
Fetch C1 for 100 Rows into :d_SQLRow;
If SQLCode <> 0;
Leave;
EndIf;
For i = 1 to SQLER3;
Elem(i) = d_SQLRow(i).CurCod;
Row += 1;
MDTest_Char_NotRegex('/':d_SQLRow(i).CurCod);
MDTest_Num_Equal(d_SQLRow(i).Exp_FX:
d_SQLRow(i).Act_FX:
d_SQLRow(i).CurCod);
MDTest_Num_InRange(d_SQLRow(i).Act_FX:
d_SQLRow(i).Exp_FX - 0,1:
d_SQLRow(i).Exp_FX + 0,1:
d_SQLRow(i).CurCod);
EndFor;
EndDo;
Exec SQL
Close C1;
MDTest_Char_In('EUR':Row:Elem);
MDTest_Char_In('GBP':Row:Elem);
End-Proc;
COBOL
2 Copy books are included in the MDTest library that must be included in the source code, in order to take advantage of the MDTest Functions
- MDTCBLWSC, to be placed in the WORKING-STORAGE SECTION. Contains all variables used by MDTest. The variables all begin with MDTEST-
- MDTCBLPRC, to be placed at the end of the PROCEDURE DIVISION. Contains helper section to invoke the MDTest procedures.
PROCESS APOST NOMONOPRC
IDENTIFICATION DIVISION.
PROGRAM-ID. CBLEXP1.
AUTHOR. Midrange Dynamics.
DATE-WRITTEN. 20.11.2023.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBMi.
OBJECT-COMPUTER. IBMi.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
*****************************************************************
DATA DIVISION.
FILE SECTION.
*****************************************************************
WORKING-STORAGE SECTION.
*** MDTest working storage variables
COPY MDTCBLWSC OF QLBLSRC.
EXEC SQL
INCLUDE SQLCA
END-EXEC.
EXEC SQL
BEGIN DECLARE SECTION
END-EXEC.
01 SQLTABLE.
05 SQLROW OCCURS 100.
10 SQLCURCOD PIC X(3).
10 SQLACT-FX PIC S9(5)V9(3) PACKED-DECIMAL.
10 SQLEXP-FX PIC S9(5)V9(3) PACKED-DECIMAL.
EXEC SQL
END DECLARE SECTION
END-EXEC.
01 WS-CNT PIC S9(3) COMP-3.
01 WS-DATE PIC X(8).
01 WS-RETURN-CODE PIC X.
01 WS-ROW PIC S9(3) COMP-3.
*****************************************************************
LINKAGE SECTION.
01 LS-CMDDURX.
05 LS-CMDDUR PIC 9(6).
01 LS-SQLDURX.
05 LS-SQLDUR PIC 9(6).
PROCEDURE DIVISION USING LS-CMDDURX, LS-SQLDURX.
000-MAIN-CONTROL SECTION.
BEG.
*** register application program for code coverage
MOVE '*LIBL' TO MDTEST-PGM-LIB
MOVE 'MDACURUPD' TO MDTEST-PGM-NAME
MOVE '*ALL' TO MDTEST-PGM-MODULE
MOVE '*PGM' TO MDTEST-PGM-TYPE
MOVE 50 TO MDTEST-MIN-PERCENTAGE
MOVE 15 TO MDTEST-MIN-LINES-HIT
MOVE 'FINANCE' TO MDTEST-REPORT-GROUP
PERFORM MDTEST-REG-CODECOV-MOD
*** skip test suite if unable to register code coverage
IF MDTEST-STATUS = 'FAIL'
GO TO XIT
END-IF
*** start timer/logging of currency update process
MOVE 10 TO MDTEST-SEV
MOVE LS-CMDDUR TO MDTEST-MAX-DURATION
MOVE 'Currency update process' TO MDTEST-MSG
PERFORM MDTEST-START-TIMER
*** Call application program to perform currency update
ACCEPT WS-DATE FROM DATE YYYYMMDD
CALL 'MYAPPLPGM' USING WS-DATE
WS-RETURN-CODE
*** end timer/logging of currency update process
PERFORM MDTEST-END-TIMER
*** generate code coverage report
MOVE 'code coverage for currency update pgm' TO MDTEST-MSG
PERFORM MDTEST-RPT-CODECOV
*** report that process failed if appl program returns E
IF WS-RETURN-CODE = 'E'
MOVE 'MYAPPLPGM returned value E' TO MDTEST-MSG
PERFORM MDTEST-FORCEFAIL
GO TO XIT
END-IF
*** set record values in a hypothetical test table
*** for demonstrating the MDTEST-EXECUTE-SQL
STRING 'UPDATE MDTEST_COMPARE_RATES A '
'SET A.CHF_FX = (RRN(A) / 10) + 1'
DELIMITED BY SIZE INTO MDTEST-CMD
MOVE LS-SQLDUR TO MDTEST-MAX-DURATION
MOVE 'Generate Test Values' TO MDTEST-MSG
PERFORM MDTEST-EXECUTE-SQL
*** skip test suite if record update failed
IF MDTEST-STATUS = 'FAIL'
GO TO XIT
END-IF
*** information message about tests
MOVE 'various tests using the test table'
TO MDTEST-MSG
PERFORM MDTEST-ADDINFO
*** loop through test table
EXEC SQL
DECLARE C1 CURSOR FOR
SELECT A.CURCOD, A.VALCHF, E.CHF_FX
FROM MDACUR A, MDTEST_COMPARE_RATES E
WHERE A.CURCOD = E.CURCOD
ORDER BY A.CURCOD
END-EXEC
EXEC SQL
OPEN C1
END-EXEC
EXEC SQL
FETCH C1 FOR 100 ROWS INTO :SQLROW
END-EXEC
IF SQLCODE = 0
PERFORM MDTEST-CLEAR-CHAR-ARRAY
MOVE SQLERRD (3) TO WS-CNT
MOVE 1 TO WS-ROW
PERFORM 100-COMPARE UNTIL WS-ROW > WS-CNT
END-IF
EXEC SQL
CLOSE C1
END-EXEC
*** check if EUR in array
MOVE 'EUR' TO MDTEST-CHAR-ELEM
PERFORM MDTEST-CHAR-IN
*** check if GBP in array
MOVE 'GBP' TO MDTEST-CHAR-ELEM
PERFORM MDTEST-CHAR-IN
.
XIT.
GOBACK.
100-COMPARE SECTION.
100.
*** add currency code to array
MOVE SQLCURCOD (WS-ROW) TO MDTEST-CHAR-ELEM
PERFORM MDTEST-ADD-CHAR-ELEM
*** check if currency code contains folder symbol using regex
MOVE '/' TO MDTEST-EXP-CHAR
MOVE SQLCURCOD (WS-ROW) TO MDTEST-ACT-CHAR
PERFORM MDTEST-CHAR-NOTREGEX
*** numeric exact test
MOVE SQLCURCOD (WS-ROW) TO MDTEST-MSG
MOVE SQLEXP-FX (WS-ROW) TO MDTEST-EXP-NUM
MOVE SQLACT-FX (WS-ROW) TO MDTEST-ACT-NUM
PERFORM MDTEST-NUM-EQUAL
*** numeric range test
MOVE SQLCURCOD (WS-ROW) TO MDTEST-MSG
COMPUTE MDTEST-RANGE-START = SQLEXP-FX (WS-ROW) - .1
COMPUTE MDTEST-RANGE-END = SQLEXP-FX (WS-ROW) + .1
MOVE SQLACT-FX (WS-ROW) TO MDTEST-ACT-NUM
PERFORM MDTEST-NUM-INRANGE
ADD 1 TO WS-ROW
.
*** MDTest procedure division sections
COPY MDTCBLPRC OF QLBLSRC.