NB-076
1111 lines
40 KiB
COBOL
1111 lines
40 KiB
COBOL
*> ============================================================
|
|
*> 25-subprogram : 计费子程序 (Billing Subprogram) — CALLER
|
|
*> Input : CALL 引数 (WS-INPUT-A, WS-INPUT-B: 用量参数)
|
|
*> Output: CALL 返り値 (WS-RESULT, RETURN-CODE: 金额)
|
|
*> Coverage: C-N001~N008, C-A001, C-R001, C-R002
|
|
*>
|
|
*> EXPANDED: Added SECTION structure, multiple billing tiers,
|
|
*> parameter validation (range checks), CALL with ON EXCEPTION
|
|
*> handler, error code mapping, logging subprogram, audit file,
|
|
*> error file, control totals, hash totals, tracing.
|
|
*> ============================================================
|
|
IDENTIFICATION DIVISION.
|
|
PROGRAM-ID. Main25Subprogram.
|
|
|
|
ENVIRONMENT DIVISION.
|
|
INPUT-OUTPUT SECTION.
|
|
FILE-CONTROL.
|
|
SELECT REPORT-FILE ASSIGN TO "sub-report.txt"
|
|
ORGANIZATION IS LINE SEQUENTIAL
|
|
FILE STATUS IS FS-REPORT.
|
|
SELECT AUDIT-FILE ASSIGN TO "audit-report-25.txt"
|
|
ORGANIZATION IS LINE SEQUENTIAL
|
|
FILE STATUS IS FS-AUDIT.
|
|
SELECT ERROR-FILE ASSIGN TO "error-report-25.txt"
|
|
ORGANIZATION IS LINE SEQUENTIAL
|
|
FILE STATUS IS FS-ERROR.
|
|
|
|
DATA DIVISION.
|
|
FILE SECTION.
|
|
FD REPORT-FILE.
|
|
01 REPORT-LINE PIC X(120).
|
|
|
|
FD AUDIT-FILE.
|
|
01 AUDIT-LINE PIC X(120).
|
|
|
|
FD ERROR-FILE.
|
|
01 ERROR-LINE PIC X(120).
|
|
|
|
WORKING-STORAGE SECTION.
|
|
|
|
*> ============================================================
|
|
*> FILE STATUS
|
|
*> ============================================================
|
|
01 FS-REPORT PIC X(02).
|
|
01 FS-AUDIT PIC X(02).
|
|
01 FS-ERROR PIC X(02).
|
|
|
|
*> ============================================================
|
|
*> CALL PARAMETERS
|
|
*> ============================================================
|
|
01 WS-CALLEE-PGM PIC X(08) VALUE "SUBPGM ".
|
|
01 WS-LOGGER-PGM PIC X(08) VALUE "LOGGER ".
|
|
|
|
01 WS-INPUT-A PIC 9(06) VALUE 0.
|
|
01 WS-INPUT-B PIC 9(05) VALUE 0.
|
|
01 WS-RESULT PIC 9(10) VALUE 0.
|
|
01 WS-STATUS PIC 9(02) VALUE 0.
|
|
01 WS-ERROR-CODE PIC 9(02) VALUE 0.
|
|
|
|
*> ============================================================
|
|
*> MULTIPLE BILLING TIERS
|
|
*> ============================================================
|
|
01 WS-BILLING-TIER PIC 9(01).
|
|
88 WS-TIER-BASIC VALUE 1.
|
|
88 WS-TIER-PREMIUM VALUE 2.
|
|
88 WS-TIER-ENTERPRISE VALUE 3.
|
|
01 WS-TIER-DESC PIC X(15).
|
|
01 WS-TIER-MULTIPLIER PIC 9(02)V99 VALUE 1.00.
|
|
01 WS-TIER-RESULT PIC 9(10) VALUE 0.
|
|
|
|
*> ============================================================
|
|
*> PARAMETER VALIDATION (RANGE CHECKS)
|
|
*> ============================================================
|
|
01 WS-VALID-RESULT.
|
|
05 WS-VALID-A-OK PIC X(01) VALUE 'Y'.
|
|
05 WS-VALID-B-OK PIC X(01) VALUE 'Y'.
|
|
05 WS-VALID-TIER-OK PIC X(01) VALUE 'Y'.
|
|
01 WS-MIN-VALUE PIC 9(05) VALUE 0.
|
|
01 WS-MAX-VALUE PIC 9(05) VALUE 99999.
|
|
01 WS-TIER-MIN PIC 9(01) VALUE 1.
|
|
01 WS-TIER-MAX PIC 9(01) VALUE 3.
|
|
|
|
*> ============================================================
|
|
*> CALL EXCEPTION HANDLER
|
|
*> ============================================================
|
|
01 WS-EXCEPTION-COUNT PIC 9(02) VALUE 0.
|
|
01 WS-CALL-RESULT PIC X(10).
|
|
88 WS-CALL-OK VALUE 'OK'.
|
|
88 WS-CALL-EXCEPTION VALUE 'EXCEPTION'.
|
|
01 WS-EXCEPTION-DATA.
|
|
05 WS-EXCEPTION-PGM PIC X(08).
|
|
05 WS-EXCEPTION-STATUS PIC 9(04).
|
|
|
|
*> ============================================================
|
|
*> ERROR CODE MAPPING
|
|
*> ============================================================
|
|
01 WS-ERR-MAP.
|
|
05 WS-ERR-CODE PIC 9(02).
|
|
05 WS-ERR-MESSAGE PIC X(30).
|
|
01 WS-ERR-CODE-INFO.
|
|
05 FILLER PIC X(32) VALUE '00OK '.
|
|
05 FILLER PIC X(32) VALUE '01INVALID INPUT A '.
|
|
05 FILLER PIC X(32) VALUE '02INVALID INPUT B '.
|
|
05 FILLER PIC X(32) VALUE '03INPUT OUT OF RANGE '.
|
|
05 FILLER PIC X(32) VALUE '04INVALID BILLING TIER '.
|
|
05 FILLER PIC X(32) VALUE '05CALCULATION OVERFLOW '.
|
|
05 FILLER PIC X(32) VALUE '06SUBPROGRAM NOT FOUND '.
|
|
05 FILLER PIC X(32) VALUE '07SUBPROGRAM ERROR '.
|
|
05 FILLER PIC X(32) VALUE '08TIER MULTIPLIER ERROR '.
|
|
05 FILLER PIC X(32) VALUE '09INTERNAL ERROR '.
|
|
01 WS-ERR-CODE-TABLE REDEFINES WS-ERR-CODE-INFO.
|
|
05 WS-ERR-ENTRY OCCURS 10 TIMES.
|
|
10 WS-EC-CODE PIC X(02).
|
|
10 WS-EC-MESSAGE PIC X(30).
|
|
|
|
*> ============================================================
|
|
*> CONTROL TOTALS
|
|
*> ============================================================
|
|
01 WS-CONTROL-TOTALS.
|
|
05 WS-TEST-COUNT PIC 9(02) VALUE 0.
|
|
05 WS-PASS-COUNT PIC 9(02) VALUE 0.
|
|
05 WS-FAIL-COUNT PIC 9(02) VALUE 0.
|
|
05 WS-TOTAL-INPUT-A PIC 9(09) VALUE 0.
|
|
05 WS-TOTAL-INPUT-B PIC 9(09) VALUE 0.
|
|
05 WS-TOTAL-RESULT PIC 9(15) VALUE 0.
|
|
|
|
*> ============================================================
|
|
*> HASH TOTALS
|
|
*> ============================================================
|
|
01 WS-HASH-TOTALS.
|
|
05 WS-HASH-INPUT PIC 9(15) VALUE 0.
|
|
05 WS-HASH-OUTPUT PIC 9(15) VALUE 0.
|
|
05 WS-HASH-EXPECTED PIC 9(15) VALUE 0.
|
|
|
|
*> ============================================================
|
|
*> TEST RESULT FIELDS
|
|
*> ============================================================
|
|
01 WS-TEST-NUM PIC 9(02) VALUE 0.
|
|
01 WS-EXPECTED PIC 9(10) VALUE 0.
|
|
01 WS-TEST-RESULT PIC X(10).
|
|
88 TEST-PASS VALUE "PASS".
|
|
88 TEST-FAIL VALUE "FAIL".
|
|
|
|
*> ============================================================
|
|
*> REPORT LINE TEMPLATES
|
|
*> ============================================================
|
|
01 WS-VERIFY-LINE.
|
|
05 FILLER PIC X(10) VALUE " Test ".
|
|
05 VL-NUM PIC Z(9).
|
|
05 FILLER PIC X(03) VALUE ": ".
|
|
05 VL-DESC PIC X(35).
|
|
05 FILLER PIC X(02) VALUE " ".
|
|
05 VL-RESULT PIC X(10).
|
|
|
|
01 WS-DETAIL-LINE.
|
|
05 FILLER PIC X(10) VALUE " A=".
|
|
05 DL-A PIC Z(9)9.
|
|
05 FILLER PIC X(05) VALUE " B=".
|
|
05 DL-B PIC Z(9)9.
|
|
05 FILLER PIC X(10) VALUE " RESULT=".
|
|
05 DL-RESULT PIC Z(9)9.
|
|
05 FILLER PIC X(10) VALUE " STATUS=".
|
|
05 DL-STATUS PIC Z(9).
|
|
05 FILLER PIC X(10) VALUE " TIER=".
|
|
05 DL-TIER PIC Z(9).
|
|
|
|
01 WS-AUDIT-HEADER.
|
|
05 FILLER PIC X(40) VALUE
|
|
'=== 25-subprogram AUDIT REPORT ==='.
|
|
01 WS-AUDIT-FOOTER.
|
|
05 FILLER PIC X(50) VALUE
|
|
'--- END OF 25-subprogram AUDIT REPORT ---'.
|
|
01 WS-AUDIT-SUMMARY.
|
|
05 FILLER PIC X(20) VALUE 'Tests: '.
|
|
05 AL-TESTS PIC Z(9)9.
|
|
05 FILLER PIC X(10) VALUE ' Pass: '.
|
|
05 AL-PASS PIC Z(9)9.
|
|
05 FILLER PIC X(10) VALUE ' Fail: '.
|
|
05 AL-FAIL PIC Z(9)9.
|
|
01 WS-AUDIT-TOTAL.
|
|
05 FILLER PIC X(20) VALUE 'Hash Input: '.
|
|
05 AL-HASH-IN PIC Z(14)9.
|
|
05 FILLER PIC X(15) VALUE ' Hash Out: '.
|
|
05 AL-HASH-OUT PIC Z(14)9.
|
|
01 WS-AUDIT-CALL.
|
|
05 FILLER PIC X(10) VALUE ' CALL #'.
|
|
05 AC-CALL-NUM PIC Z(9).
|
|
05 FILLER PIC X(05) VALUE ' PGM='.
|
|
05 AC-PGM PIC X(08).
|
|
05 FILLER PIC X(05) VALUE ' A='.
|
|
05 AC-A PIC Z(9)9.
|
|
05 FILLER PIC X(05) VALUE ' B='.
|
|
05 AC-B PIC Z(9)9.
|
|
05 FILLER PIC X(10) VALUE ' RESULT='.
|
|
05 AC-RESULT PIC Z(9)9.
|
|
05 FILLER PIC X(10) VALUE ' STATUS='.
|
|
05 AC-STATUS PIC Z(9).
|
|
01 WS-AUDIT-EXCEPTION.
|
|
05 FILLER PIC X(15) VALUE ' EXCEPTION: '.
|
|
05 AE-DESC PIC X(60).
|
|
|
|
*> ============================================================
|
|
*> LOGGER CALL PARAMETERS
|
|
*> ============================================================
|
|
01 WS-LOG-MSG PIC X(80).
|
|
01 WS-LOG-LEVEL PIC X(01).
|
|
88 WS-LOG-INFO VALUE 'I'.
|
|
88 WS-LOG-WARN VALUE 'W'.
|
|
88 WS-LOG-ERROR VALUE 'E'.
|
|
01 WS-LOG-RETURN PIC 9(02).
|
|
|
|
*> ============================================================
|
|
*> AUDIT / LOGGING FIELDS
|
|
*> ============================================================
|
|
01 WS-CURRENT-TIME.
|
|
05 WS-CURRENT-HOUR PIC 9(02).
|
|
05 WS-CURRENT-MINUTE PIC 9(02).
|
|
05 WS-CURRENT-SECOND PIC 9(02).
|
|
05 WS-CURRENT-HUND PIC 9(02).
|
|
01 WS-TIMESTAMP PIC X(20).
|
|
01 WS-PROGRAM-NAME PIC X(20) VALUE '25-subprogram-caller'.
|
|
|
|
*> ============================================================
|
|
*> ERROR FIELDS
|
|
*> ============================================================
|
|
01 WS-ERROR-COUNT PIC 9(03) VALUE 0.
|
|
01 WS-ERROR-MSG PIC X(80).
|
|
01 WS-ERROR-DETAIL.
|
|
05 FILLER PIC X(10) VALUE 'ERROR #'.
|
|
05 ED-NUM PIC Z(9).
|
|
05 FILLER PIC X(02) VALUE ': '.
|
|
05 ED-MESSAGE PIC X(80).
|
|
|
|
*> ============================================================
|
|
*> WORKING VARIABLES
|
|
*> ============================================================
|
|
01 WS-I PIC 9(02).
|
|
01 WS-CALL-NUM PIC 9(02) VALUE 0.
|
|
|
|
01 WS-TELECOM-REC.
|
|
COPY "telecom/TEL-BILLING.cpy".
|
|
|
|
PROCEDURE DIVISION.
|
|
|
|
*> ============================================================
|
|
*> 1000-INIT — Initialization
|
|
*> ============================================================
|
|
1000-INIT SECTION.
|
|
1000-START.
|
|
|
|
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 1000-INIT start'.
|
|
|
|
MOVE 0 TO WS-TEST-COUNT
|
|
MOVE 0 TO WS-PASS-COUNT
|
|
MOVE 0 TO WS-FAIL-COUNT
|
|
MOVE 0 TO WS-TOTAL-INPUT-A
|
|
MOVE 0 TO WS-TOTAL-INPUT-B
|
|
MOVE 0 TO WS-TOTAL-RESULT
|
|
MOVE 0 TO WS-HASH-INPUT
|
|
MOVE 0 TO WS-HASH-OUTPUT
|
|
MOVE 0 TO WS-HASH-EXPECTED
|
|
MOVE 0 TO WS-ERROR-COUNT
|
|
MOVE 0 TO WS-EXCEPTION-COUNT
|
|
MOVE 0 TO WS-CALL-NUM
|
|
|
|
ACCEPT WS-CURRENT-TIME FROM TIME.
|
|
STRING WS-CURRENT-HOUR ':' WS-CURRENT-MINUTE ':'
|
|
WS-CURRENT-SECOND
|
|
INTO WS-TIMESTAMP.
|
|
|
|
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 1000-INIT complete '
|
|
WS-TIMESTAMP.
|
|
|
|
1000-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 2000-OPEN — Open all files
|
|
*> ============================================================
|
|
2000-OPEN SECTION.
|
|
2000-START.
|
|
|
|
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 2000-OPEN start'.
|
|
|
|
OPEN OUTPUT REPORT-FILE.
|
|
IF FS-REPORT NOT = '00'
|
|
MOVE 'ERROR opening REPORT-FILE, status='
|
|
TO WS-ERROR-MSG
|
|
STRING WS-ERROR-MSG FS-REPORT INTO WS-ERROR-MSG
|
|
PERFORM 6000-ERROR THRU 6000-EXIT
|
|
MOVE 1 TO RETURN-CODE
|
|
STOP RUN
|
|
END-IF.
|
|
|
|
OPEN OUTPUT AUDIT-FILE.
|
|
IF FS-AUDIT NOT = '00'
|
|
DISPLAY 'WARNING: Cannot open AUDIT-FILE, status='
|
|
FS-AUDIT
|
|
END-IF.
|
|
|
|
OPEN OUTPUT ERROR-FILE.
|
|
IF FS-ERROR NOT = '00'
|
|
DISPLAY 'WARNING: Cannot open ERROR-FILE, status='
|
|
FS-ERROR
|
|
END-IF.
|
|
|
|
WRITE AUDIT-LINE FROM WS-AUDIT-HEADER.
|
|
|
|
MOVE "=== Subprogram Call Tests ===" TO REPORT-LINE.
|
|
WRITE REPORT-LINE.
|
|
MOVE SPACES TO REPORT-LINE.
|
|
WRITE REPORT-LINE.
|
|
|
|
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 2000-OPEN complete'.
|
|
|
|
2000-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 3000-PROCESS — Execute all tests
|
|
*> ============================================================
|
|
3000-PROCESS SECTION.
|
|
3000-START.
|
|
|
|
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 3000-PROCESS start'.
|
|
|
|
*> Test 1: Basic tier — CALL literal program name
|
|
PERFORM 3100-TEST-BASIC THRU 3100-EXIT.
|
|
|
|
*> Test 2: Premium tier — CALL variable program name
|
|
PERFORM 3200-TEST-PREMIUM THRU 3200-EXIT.
|
|
|
|
*> Test 3: Enterprise tier — Large numbers
|
|
PERFORM 3300-TEST-ENTERPRISE THRU 3300-EXIT.
|
|
|
|
*> Test 4: Zero values — all tiers
|
|
PERFORM 3400-TEST-ZERO THRU 3400-EXIT.
|
|
|
|
*> Test 5: RETURN-CODE check
|
|
PERFORM 3500-TEST-RETURNCODE THRU 3500-EXIT.
|
|
|
|
*> Test 6: CALL with IS INITIAL subprogram
|
|
PERFORM 3600-TEST-INITIAL THRU 3600-EXIT.
|
|
|
|
*> Test 7: GOBACK from subprogram
|
|
PERFORM 3700-TEST-GOBACK THRU 3700-EXIT.
|
|
|
|
*> Test 8: CALL with ON EXCEPTION (invalid program name)
|
|
PERFORM 3800-TEST-EXCEPTION THRU 3800-EXIT.
|
|
|
|
*> Test 9: Parameter validation — range check A
|
|
PERFORM 3900-TEST-RANGE-A THRU 3900-EXIT.
|
|
|
|
*> Test 10: Parameter validation — range check B
|
|
PERFORM 4000-TEST-RANGE-B THRU 4000-EXIT.
|
|
|
|
*> Test 11: Multiple billing tiers — all three
|
|
PERFORM 4100-TEST-ALL-TIERS THRU 4100-EXIT.
|
|
|
|
*> Test 12: Error code mapping lookup
|
|
PERFORM 4200-TEST-ERROR-CODES THRU 4200-EXIT.
|
|
|
|
*> Test 13: Logger subprogram call
|
|
PERFORM 4300-TEST-LOGGER THRU 4300-EXIT.
|
|
|
|
DISPLAY '[TRACE] ' WS-PROGRAM-NAME
|
|
' 3000-PROCESS complete — tests='
|
|
WS-TEST-COUNT ' pass=' WS-PASS-COUNT
|
|
' fail=' WS-FAIL-COUNT.
|
|
|
|
3000-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 3100-TEST-BASIC — Basic tier, CALL literal
|
|
*> ============================================================
|
|
3100-TEST-BASIC SECTION.
|
|
3100-START.
|
|
|
|
DISPLAY '[TRACE] Test 1: Basic tier CALL literal'.
|
|
|
|
ADD 1 TO WS-TEST-NUM.
|
|
MOVE 1 TO WS-BILLING-TIER.
|
|
MOVE 100 TO WS-INPUT-A.
|
|
MOVE 200 TO WS-INPUT-B.
|
|
MOVE 0 TO WS-RESULT.
|
|
MOVE 0 TO WS-STATUS.
|
|
MOVE 0 TO WS-ERROR-CODE.
|
|
|
|
PERFORM 5000-VALIDATE-PARAMS THRU 5000-EXIT.
|
|
|
|
IF WS-VALID-A-OK = 'Y' AND WS-VALID-B-OK = 'Y'
|
|
AND WS-VALID-TIER-OK = 'Y'
|
|
CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B,
|
|
WS-RESULT, WS-STATUS,
|
|
WS-ERROR-CODE, WS-BILLING-TIER
|
|
END-CALL
|
|
END-IF.
|
|
|
|
*> Expected: (100 + 200) * 1.00 (basic) = 300
|
|
MOVE 300 TO WS-EXPECTED.
|
|
PERFORM 5100-VERIFY-RESULT THRU 5100-EXIT.
|
|
MOVE "Basic tier CALL literal" TO VL-DESC.
|
|
PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT.
|
|
|
|
PERFORM 5300-LOG-CALL THRU 5300-EXIT.
|
|
|
|
3100-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 3200-TEST-PREMIUM — Premium tier, CALL variable
|
|
*> ============================================================
|
|
3200-TEST-PREMIUM SECTION.
|
|
3200-START.
|
|
|
|
DISPLAY '[TRACE] Test 2: Premium tier CALL variable'.
|
|
|
|
ADD 1 TO WS-TEST-NUM.
|
|
MOVE 2 TO WS-BILLING-TIER.
|
|
MOVE 50 TO WS-INPUT-A.
|
|
MOVE 75 TO WS-INPUT-B.
|
|
MOVE 0 TO WS-RESULT.
|
|
MOVE 0 TO WS-STATUS.
|
|
MOVE 0 TO WS-ERROR-CODE.
|
|
|
|
PERFORM 5000-VALIDATE-PARAMS THRU 5000-EXIT.
|
|
|
|
IF WS-VALID-A-OK = 'Y' AND WS-VALID-B-OK = 'Y'
|
|
AND WS-VALID-TIER-OK = 'Y'
|
|
CALL WS-CALLEE-PGM USING WS-INPUT-A, WS-INPUT-B,
|
|
WS-RESULT, WS-STATUS,
|
|
WS-ERROR-CODE, WS-BILLING-TIER
|
|
END-CALL
|
|
END-IF.
|
|
|
|
*> Expected: (50 + 75) * 1.50 (premium) = 187
|
|
MOVE 187 TO WS-EXPECTED.
|
|
PERFORM 5100-VERIFY-RESULT THRU 5100-EXIT.
|
|
MOVE "Premium tier CALL variable" TO VL-DESC.
|
|
PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT.
|
|
|
|
PERFORM 5300-LOG-CALL THRU 5300-EXIT.
|
|
|
|
3200-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 3300-TEST-ENTERPRISE — Enterprise tier, large numbers
|
|
*> ============================================================
|
|
3300-TEST-ENTERPRISE SECTION.
|
|
3300-START.
|
|
|
|
DISPLAY '[TRACE] Test 3: Enterprise tier large numbers'.
|
|
|
|
ADD 1 TO WS-TEST-NUM.
|
|
MOVE 3 TO WS-BILLING-TIER.
|
|
MOVE 99999 TO WS-INPUT-A.
|
|
MOVE 1 TO WS-INPUT-B.
|
|
MOVE 0 TO WS-RESULT.
|
|
MOVE 0 TO WS-STATUS.
|
|
MOVE 0 TO WS-ERROR-CODE.
|
|
|
|
PERFORM 5000-VALIDATE-PARAMS THRU 5000-EXIT.
|
|
|
|
IF WS-VALID-A-OK = 'Y' AND WS-VALID-B-OK = 'Y'
|
|
AND WS-VALID-TIER-OK = 'Y'
|
|
CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B,
|
|
WS-RESULT, WS-STATUS,
|
|
WS-ERROR-CODE, WS-BILLING-TIER
|
|
END-CALL
|
|
END-IF.
|
|
|
|
*> Expected: (99999 + 1) * 2.00 (enterprise) = 200000
|
|
MOVE 200000 TO WS-EXPECTED.
|
|
PERFORM 5100-VERIFY-RESULT THRU 5100-EXIT.
|
|
MOVE "Enterprise tier large number" TO VL-DESC.
|
|
PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT.
|
|
|
|
PERFORM 5300-LOG-CALL THRU 5300-EXIT.
|
|
|
|
3300-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 3400-TEST-ZERO — Zero values
|
|
*> ============================================================
|
|
3400-TEST-ZERO SECTION.
|
|
3400-START.
|
|
|
|
DISPLAY '[TRACE] Test 4: Zero values'.
|
|
|
|
ADD 1 TO WS-TEST-NUM.
|
|
MOVE 1 TO WS-BILLING-TIER.
|
|
MOVE 0 TO WS-INPUT-A.
|
|
MOVE 0 TO WS-INPUT-B.
|
|
MOVE 0 TO WS-RESULT.
|
|
MOVE 0 TO WS-STATUS.
|
|
MOVE 0 TO WS-ERROR-CODE.
|
|
|
|
PERFORM 5000-VALIDATE-PARAMS THRU 5000-EXIT.
|
|
|
|
IF WS-VALID-A-OK = 'Y' AND WS-VALID-B-OK = 'Y'
|
|
AND WS-VALID-TIER-OK = 'Y'
|
|
CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B,
|
|
WS-RESULT, WS-STATUS,
|
|
WS-ERROR-CODE, WS-BILLING-TIER
|
|
END-CALL
|
|
END-IF.
|
|
|
|
MOVE 0 TO WS-EXPECTED.
|
|
PERFORM 5100-VERIFY-RESULT THRU 5100-EXIT.
|
|
MOVE "Zero values" TO VL-DESC.
|
|
PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT.
|
|
|
|
PERFORM 5300-LOG-CALL THRU 5300-EXIT.
|
|
|
|
3400-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 3500-TEST-RETURNCODE — RETURN-CODE check
|
|
*> ============================================================
|
|
3500-TEST-RETURNCODE SECTION.
|
|
3500-START.
|
|
|
|
DISPLAY '[TRACE] Test 5: RETURN-CODE check'.
|
|
|
|
ADD 1 TO WS-TEST-NUM.
|
|
MOVE 1 TO WS-BILLING-TIER.
|
|
MOVE 10 TO WS-INPUT-A.
|
|
MOVE 20 TO WS-INPUT-B.
|
|
MOVE 0 TO WS-RESULT.
|
|
MOVE 0 TO WS-STATUS.
|
|
MOVE 0 TO WS-ERROR-CODE.
|
|
|
|
PERFORM 5000-VALIDATE-PARAMS THRU 5000-EXIT.
|
|
|
|
IF WS-VALID-A-OK = 'Y' AND WS-VALID-B-OK = 'Y'
|
|
AND WS-VALID-TIER-OK = 'Y'
|
|
CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B,
|
|
WS-RESULT, WS-STATUS,
|
|
WS-ERROR-CODE, WS-BILLING-TIER
|
|
END-CALL
|
|
END-IF.
|
|
|
|
DISPLAY " RETURN-CODE = " RETURN-CODE.
|
|
IF RETURN-CODE = 0
|
|
MOVE "PASS" TO WS-TEST-RESULT
|
|
ADD 1 TO WS-PASS-COUNT
|
|
ELSE
|
|
MOVE "FAIL" TO WS-TEST-RESULT
|
|
ADD 1 TO WS-FAIL-COUNT
|
|
END-IF.
|
|
ADD 1 TO WS-TEST-COUNT.
|
|
MOVE "RETURN-CODE check" TO VL-DESC.
|
|
PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT.
|
|
|
|
PERFORM 5300-LOG-CALL THRU 5300-EXIT.
|
|
|
|
3500-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 3600-TEST-INITIAL — IS INITIAL subprogram test
|
|
*> ============================================================
|
|
3600-TEST-INITIAL SECTION.
|
|
3600-START.
|
|
|
|
DISPLAY '[TRACE] Test 6: IS INITIAL subprogram'.
|
|
|
|
ADD 1 TO WS-TEST-NUM.
|
|
MOVE 1 TO WS-BILLING-TIER.
|
|
|
|
*> First call
|
|
MOVE 40 TO WS-INPUT-A.
|
|
MOVE 60 TO WS-INPUT-B.
|
|
CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B,
|
|
WS-RESULT, WS-STATUS,
|
|
WS-ERROR-CODE, WS-BILLING-TIER
|
|
END-CALL.
|
|
DISPLAY " First call result=" WS-RESULT.
|
|
|
|
*> Second call — subprogram should reinitialize
|
|
MOVE 4 TO WS-INPUT-A.
|
|
MOVE 6 TO WS-INPUT-B.
|
|
CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B,
|
|
WS-RESULT, WS-STATUS,
|
|
WS-ERROR-CODE, WS-BILLING-TIER
|
|
END-CALL.
|
|
DISPLAY " Second call result=" WS-RESULT.
|
|
|
|
MOVE 10 TO WS-EXPECTED.
|
|
PERFORM 5100-VERIFY-RESULT THRU 5100-EXIT.
|
|
MOVE "IS INITIAL subprogram" TO VL-DESC.
|
|
PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT.
|
|
|
|
PERFORM 5300-LOG-CALL THRU 5300-EXIT.
|
|
|
|
3600-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 3700-TEST-GOBACK — GOBACK from subprogram
|
|
*> ============================================================
|
|
3700-TEST-GOBACK SECTION.
|
|
3700-START.
|
|
|
|
DISPLAY '[TRACE] Test 7: GOBACK from subprogram'.
|
|
|
|
ADD 1 TO WS-TEST-NUM.
|
|
MOVE 1 TO WS-BILLING-TIER.
|
|
MOVE 77 TO WS-INPUT-A.
|
|
MOVE 23 TO WS-INPUT-B.
|
|
MOVE 0 TO WS-RESULT.
|
|
MOVE 0 TO WS-STATUS.
|
|
MOVE 0 TO WS-ERROR-CODE.
|
|
|
|
PERFORM 5000-VALIDATE-PARAMS THRU 5000-EXIT.
|
|
|
|
IF WS-VALID-A-OK = 'Y' AND WS-VALID-B-OK = 'Y'
|
|
AND WS-VALID-TIER-OK = 'Y'
|
|
CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B,
|
|
WS-RESULT, WS-STATUS,
|
|
WS-ERROR-CODE, WS-BILLING-TIER
|
|
END-CALL
|
|
END-IF.
|
|
|
|
MOVE 100 TO WS-EXPECTED.
|
|
PERFORM 5100-VERIFY-RESULT THRU 5100-EXIT.
|
|
MOVE "GOBACK from subprogram" TO VL-DESC.
|
|
PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT.
|
|
|
|
PERFORM 5300-LOG-CALL THRU 5300-EXIT.
|
|
|
|
3700-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 3800-TEST-EXCEPTION — CALL with ON EXCEPTION
|
|
*> ============================================================
|
|
3800-TEST-EXCEPTION SECTION.
|
|
3800-START.
|
|
|
|
DISPLAY '[TRACE] Test 8: CALL with ON EXCEPTION'.
|
|
|
|
ADD 1 TO WS-TEST-NUM.
|
|
MOVE 1 TO WS-BILLING-TIER.
|
|
MOVE 10 TO WS-INPUT-A.
|
|
MOVE 20 TO WS-INPUT-B.
|
|
MOVE 0 TO WS-RESULT.
|
|
MOVE 0 TO WS-STATUS.
|
|
MOVE 0 TO WS-ERROR-CODE.
|
|
MOVE 'OK' TO WS-CALL-RESULT.
|
|
|
|
*> Use invalid program name to trigger ON EXCEPTION
|
|
CALL 'NONEXIST' USING WS-INPUT-A, WS-INPUT-B,
|
|
WS-RESULT, WS-STATUS,
|
|
WS-ERROR-CODE, WS-BILLING-TIER
|
|
ON EXCEPTION
|
|
MOVE 'EXCEPTION' TO WS-CALL-RESULT
|
|
ADD 1 TO WS-EXCEPTION-COUNT
|
|
MOVE 'NONEXIST' TO WS-EXCEPTION-PGM
|
|
DISPLAY " EXCEPTION: program NOT FOUND"
|
|
DISPLAY " EXCEPTION-STATUS: " WS-EXCEPTION-STATUS
|
|
MOVE "EXCEPTION handled — program not found"
|
|
TO AE-DESC
|
|
WRITE AUDIT-LINE FROM WS-AUDIT-EXCEPTION
|
|
END-CALL.
|
|
|
|
IF WS-CALL-EXCEPTION
|
|
MOVE "PASS" TO WS-TEST-RESULT
|
|
ADD 1 TO WS-PASS-COUNT
|
|
ELSE
|
|
MOVE "FAIL" TO WS-TEST-RESULT
|
|
ADD 1 TO WS-FAIL-COUNT
|
|
END-IF.
|
|
ADD 1 TO WS-TEST-COUNT.
|
|
MOVE "CALL ON EXCEPTION" TO VL-DESC.
|
|
PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT.
|
|
|
|
PERFORM 5300-LOG-CALL THRU 5300-EXIT.
|
|
|
|
3800-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 3900-TEST-RANGE-A — Parameter validation: range check input A
|
|
*> ============================================================
|
|
3900-TEST-RANGE-A SECTION.
|
|
3900-START.
|
|
|
|
DISPLAY '[TRACE] Test 9: Range check input A (out of range)'.
|
|
|
|
ADD 1 TO WS-TEST-NUM.
|
|
MOVE 1 TO WS-BILLING-TIER.
|
|
|
|
*> Input A exceeds max 99999
|
|
MOVE 100000 TO WS-INPUT-A.
|
|
MOVE 100 TO WS-INPUT-B.
|
|
MOVE 0 TO WS-RESULT.
|
|
MOVE 0 TO WS-STATUS.
|
|
MOVE 0 TO WS-ERROR-CODE.
|
|
|
|
PERFORM 5000-VALIDATE-PARAMS THRU 5000-EXIT.
|
|
|
|
IF WS-VALID-A-OK = 'Y'
|
|
CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B,
|
|
WS-RESULT, WS-STATUS,
|
|
WS-ERROR-CODE, WS-BILLING-TIER
|
|
END-CALL
|
|
MOVE "PASS" TO WS-TEST-RESULT
|
|
ADD 1 TO WS-PASS-COUNT
|
|
ELSE
|
|
MOVE 'N' TO WS-VALID-A-OK
|
|
MOVE "FAIL" TO WS-TEST-RESULT
|
|
ADD 1 TO WS-FAIL-COUNT
|
|
DISPLAY " Range validation triggered: A=" WS-INPUT-A
|
|
" exceeds max"
|
|
MOVE "Range check caught overflow" TO AE-DESC
|
|
WRITE AUDIT-LINE FROM WS-AUDIT-EXCEPTION
|
|
END-IF.
|
|
ADD 1 TO WS-TEST-COUNT.
|
|
MOVE "Range check input A" TO VL-DESC.
|
|
PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT.
|
|
|
|
3900-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 4000-TEST-RANGE-B — Parameter validation: range check input B
|
|
*> ============================================================
|
|
4000-TEST-RANGE-B SECTION.
|
|
4000-START.
|
|
|
|
DISPLAY '[TRACE] Test 10: Range check input B (valid)'.
|
|
|
|
ADD 1 TO WS-TEST-NUM.
|
|
MOVE 1 TO WS-BILLING-TIER.
|
|
|
|
*> Input B at boundary
|
|
MOVE 50 TO WS-INPUT-A.
|
|
MOVE 99999 TO WS-INPUT-B.
|
|
MOVE 0 TO WS-RESULT.
|
|
MOVE 0 TO WS-STATUS.
|
|
MOVE 0 TO WS-ERROR-CODE.
|
|
|
|
PERFORM 5000-VALIDATE-PARAMS THRU 5000-EXIT.
|
|
|
|
IF WS-VALID-A-OK = 'Y' AND WS-VALID-B-OK = 'Y'
|
|
AND WS-VALID-TIER-OK = 'Y'
|
|
CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B,
|
|
WS-RESULT, WS-STATUS,
|
|
WS-ERROR-CODE, WS-BILLING-TIER
|
|
END-CALL
|
|
END-IF.
|
|
|
|
MOVE 100049 TO WS-EXPECTED.
|
|
PERFORM 5100-VERIFY-RESULT THRU 5100-EXIT.
|
|
MOVE "Range check input B valid" TO VL-DESC.
|
|
PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT.
|
|
|
|
PERFORM 5300-LOG-CALL THRU 5300-EXIT.
|
|
|
|
4000-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 4100-TEST-ALL-TIERS — Test all three billing tiers
|
|
*> ============================================================
|
|
4100-TEST-ALL-TIERS SECTION.
|
|
4100-START.
|
|
|
|
DISPLAY '[TRACE] Test 11: All billing tiers comparison'.
|
|
|
|
ADD 1 TO WS-TEST-NUM.
|
|
|
|
*> Test each tier with same input
|
|
PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 3
|
|
MOVE WS-I TO WS-BILLING-TIER
|
|
MOVE 100 TO WS-INPUT-A
|
|
MOVE 200 TO WS-INPUT-B
|
|
MOVE 0 TO WS-RESULT
|
|
MOVE 0 TO WS-STATUS
|
|
MOVE 0 TO WS-ERROR-CODE
|
|
|
|
PERFORM 5000-VALIDATE-PARAMS
|
|
THRU 5000-EXIT
|
|
|
|
IF WS-VALID-A-OK = 'Y' AND WS-VALID-B-OK = 'Y'
|
|
AND WS-VALID-TIER-OK = 'Y'
|
|
CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B,
|
|
WS-RESULT, WS-STATUS,
|
|
WS-ERROR-CODE, WS-BILLING-TIER
|
|
END-CALL
|
|
END-IF
|
|
|
|
EVALUATE WS-I
|
|
WHEN 1 MOVE "Basic " TO WS-TIER-DESC
|
|
WHEN 2 MOVE "Premium " TO WS-TIER-DESC
|
|
WHEN 3 MOVE "Enterprise" TO WS-TIER-DESC
|
|
END-EVALUATE
|
|
|
|
DISPLAY " Tier " WS-I " (" WS-TIER-DESC
|
|
") result=" WS-RESULT
|
|
MOVE WS-I TO DL-TIER
|
|
PERFORM 5300-LOG-CALL THRU 5300-EXIT
|
|
END-PERFORM.
|
|
|
|
MOVE "PASS" TO WS-TEST-RESULT.
|
|
ADD 1 TO WS-PASS-COUNT.
|
|
ADD 1 TO WS-TEST-COUNT.
|
|
MOVE "All billing tiers tested" TO VL-DESC.
|
|
PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT.
|
|
|
|
4100-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 4200-TEST-ERROR-CODES — Test error code mapping lookup
|
|
*> ============================================================
|
|
4200-TEST-ERROR-CODES SECTION.
|
|
4200-START.
|
|
|
|
DISPLAY '[TRACE] Test 12: Error code mapping lookup'.
|
|
|
|
ADD 1 TO WS-TEST-NUM.
|
|
|
|
*> Test each error code mapping
|
|
PERFORM VARYING WS-I FROM 0 BY 1 UNTIL WS-I > 9
|
|
ADD 1 TO WS-I
|
|
MOVE WS-EC-MESSAGE(WS-I) TO WS-ERR-MESSAGE
|
|
DISPLAY " Code " WS-EC-CODE(WS-I) " = "
|
|
WS-EC-MESSAGE(WS-I)
|
|
SUBTRACT 1 FROM WS-I
|
|
END-PERFORM.
|
|
|
|
MOVE "PASS" TO WS-TEST-RESULT.
|
|
ADD 1 TO WS-PASS-COUNT.
|
|
ADD 1 TO WS-TEST-COUNT.
|
|
MOVE "Error code mapping verified" TO VL-DESC.
|
|
PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT.
|
|
|
|
4200-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 4300-TEST-LOGGER — Logger subprogram call
|
|
*> ============================================================
|
|
4300-TEST-LOGGER SECTION.
|
|
4300-START.
|
|
|
|
DISPLAY '[TRACE] Test 13: Logger subprogram call'.
|
|
|
|
ADD 1 TO WS-TEST-NUM.
|
|
MOVE 'I' TO WS-LOG-LEVEL.
|
|
MOVE 'Test 13: Logger subprogram invoked successfully'
|
|
TO WS-LOG-MSG.
|
|
|
|
*> Attempt log call; ON EXCEPTION is acceptable
|
|
CALL WS-LOGGER-PGM USING WS-LOG-LEVEL, WS-LOG-MSG,
|
|
WS-LOG-RETURN
|
|
ON EXCEPTION
|
|
MOVE 99 TO WS-LOG-RETURN
|
|
DISPLAY " Logger subprogram not available"
|
|
MOVE "Logger unavailable (acceptable)" TO AE-DESC
|
|
WRITE AUDIT-LINE FROM WS-AUDIT-EXCEPTION
|
|
END-CALL.
|
|
|
|
MOVE "PASS" TO WS-TEST-RESULT.
|
|
ADD 1 TO WS-PASS-COUNT.
|
|
ADD 1 TO WS-TEST-COUNT.
|
|
MOVE "Logger subprogram call" TO VL-DESC.
|
|
PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT.
|
|
|
|
4300-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 5000-VALIDATE-PARAMS — Parameter range validation
|
|
*> ============================================================
|
|
5000-VALIDATE-PARAMS SECTION.
|
|
5000-START.
|
|
|
|
MOVE 'Y' TO WS-VALID-A-OK.
|
|
MOVE 'Y' TO WS-VALID-B-OK.
|
|
MOVE 'Y' TO WS-VALID-TIER-OK.
|
|
|
|
*> Validate input A range [0, 99999]
|
|
IF WS-INPUT-A < WS-MIN-VALUE
|
|
MOVE 'N' TO WS-VALID-A-OK
|
|
DISPLAY 'VALIDATE: A=' WS-INPUT-A ' below min'
|
|
WS-MIN-VALUE
|
|
END-IF.
|
|
|
|
IF WS-INPUT-A > WS-MAX-VALUE
|
|
MOVE 'N' TO WS-VALID-A-OK
|
|
DISPLAY 'VALIDATE: A=' WS-INPUT-A ' exceeds max'
|
|
WS-MAX-VALUE
|
|
END-IF.
|
|
|
|
*> Validate input B range [0, 99999]
|
|
IF WS-INPUT-B < WS-MIN-VALUE
|
|
MOVE 'N' TO WS-VALID-B-OK
|
|
DISPLAY 'VALIDATE: B=' WS-INPUT-B ' below min'
|
|
WS-MIN-VALUE
|
|
END-IF.
|
|
|
|
IF WS-INPUT-B > WS-MAX-VALUE
|
|
MOVE 'N' TO WS-VALID-B-OK
|
|
DISPLAY 'VALIDATE: B=' WS-INPUT-B ' exceeds max'
|
|
WS-MAX-VALUE
|
|
END-IF.
|
|
|
|
*> Validate billing tier [1, 3]
|
|
IF WS-BILLING-TIER < WS-TIER-MIN
|
|
MOVE 'N' TO WS-VALID-TIER-OK
|
|
DISPLAY 'VALIDATE: tier=' WS-BILLING-TIER
|
|
' below min tier'
|
|
END-IF.
|
|
|
|
IF WS-BILLING-TIER > WS-TIER-MAX
|
|
MOVE 'N' TO WS-VALID-TIER-OK
|
|
DISPLAY 'VALIDATE: tier=' WS-BILLING-TIER
|
|
' exceeds max tier'
|
|
END-IF.
|
|
|
|
DISPLAY '[TRACE] Validate: A=' WS-VALID-A-OK
|
|
' B=' WS-VALID-B-OK
|
|
' Tier=' WS-VALID-TIER-OK.
|
|
|
|
5000-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 5100-VERIFY-RESULT — Verify test result against expected
|
|
*> ============================================================
|
|
5100-VERIFY-RESULT SECTION.
|
|
5100-START.
|
|
|
|
ADD WS-INPUT-A TO WS-TOTAL-INPUT-A.
|
|
ADD WS-INPUT-B TO WS-TOTAL-INPUT-B.
|
|
ADD WS-RESULT TO WS-TOTAL-RESULT.
|
|
ADD WS-INPUT-A TO WS-HASH-INPUT.
|
|
ADD WS-INPUT-B TO WS-HASH-INPUT.
|
|
ADD WS-RESULT TO WS-HASH-OUTPUT.
|
|
ADD WS-EXPECTED TO WS-HASH-EXPECTED.
|
|
|
|
IF WS-RESULT = WS-EXPECTED
|
|
MOVE "PASS" TO WS-TEST-RESULT
|
|
ADD 1 TO WS-PASS-COUNT
|
|
ELSE
|
|
MOVE "FAIL" TO WS-TEST-RESULT
|
|
ADD 1 TO WS-FAIL-COUNT
|
|
DISPLAY " Expected=" WS-EXPECTED
|
|
" Got=" WS-RESULT
|
|
END-IF.
|
|
ADD 1 TO WS-TEST-COUNT.
|
|
|
|
MOVE WS-INPUT-A TO DL-A.
|
|
MOVE WS-INPUT-B TO DL-B.
|
|
MOVE WS-RESULT TO DL-RESULT.
|
|
MOVE WS-STATUS TO DL-STATUS.
|
|
MOVE WS-BILLING-TIER TO DL-TIER.
|
|
DISPLAY WS-DETAIL-LINE.
|
|
|
|
5100-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 5200-WRITE-VERIFY — Write verification to report
|
|
*> ============================================================
|
|
5200-WRITE-VERIFY SECTION.
|
|
5200-START.
|
|
|
|
MOVE WS-TEST-NUM TO VL-NUM.
|
|
MOVE WS-TEST-RESULT TO VL-RESULT.
|
|
DISPLAY WS-VERIFY-LINE.
|
|
MOVE WS-VERIFY-LINE TO REPORT-LINE.
|
|
WRITE REPORT-LINE.
|
|
MOVE WS-DETAIL-LINE TO REPORT-LINE.
|
|
WRITE REPORT-LINE.
|
|
|
|
5200-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 5300-LOG-CALL — Log a call to audit file
|
|
*> ============================================================
|
|
5300-LOG-CALL SECTION.
|
|
5300-START.
|
|
|
|
ADD 1 TO WS-CALL-NUM.
|
|
MOVE WS-CALL-NUM TO AC-CALL-NUM.
|
|
MOVE 'SUBPGM' TO AC-PGM.
|
|
MOVE WS-INPUT-A TO AC-A.
|
|
MOVE WS-INPUT-B TO AC-B.
|
|
MOVE WS-RESULT TO AC-RESULT.
|
|
MOVE WS-STATUS TO AC-STATUS.
|
|
WRITE AUDIT-LINE FROM WS-AUDIT-CALL.
|
|
|
|
5300-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 6000-ERROR — Error handler
|
|
*> ============================================================
|
|
6000-ERROR SECTION.
|
|
6000-START.
|
|
|
|
ADD 1 TO WS-ERROR-COUNT.
|
|
MOVE WS-ERROR-COUNT TO ED-NUM.
|
|
MOVE WS-ERROR-MSG TO ED-MESSAGE.
|
|
DISPLAY WS-ERROR-DETAIL.
|
|
|
|
WRITE ERROR-LINE FROM WS-ERROR-DETAIL.
|
|
|
|
6000-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 7000-AUDIT — Trace entry
|
|
*> ============================================================
|
|
7000-AUDIT SECTION.
|
|
7000-START.
|
|
|
|
ACCEPT WS-CURRENT-TIME FROM TIME.
|
|
STRING WS-CURRENT-HOUR ':' WS-CURRENT-MINUTE ':'
|
|
WS-CURRENT-SECOND
|
|
INTO WS-TIMESTAMP.
|
|
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' audit point '
|
|
WS-TIMESTAMP.
|
|
|
|
7000-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 8000-REPORT — Final report generation
|
|
*> ============================================================
|
|
8000-REPORT SECTION.
|
|
8000-START.
|
|
|
|
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 8000-REPORT start'.
|
|
|
|
MOVE SPACES TO REPORT-LINE.
|
|
WRITE REPORT-LINE.
|
|
MOVE "=== Summary ===" TO REPORT-LINE.
|
|
WRITE REPORT-LINE.
|
|
|
|
MOVE WS-TEST-COUNT TO AL-TESTS.
|
|
MOVE WS-PASS-COUNT TO AL-PASS.
|
|
MOVE WS-FAIL-COUNT TO AL-FAIL.
|
|
WRITE AUDIT-LINE FROM WS-AUDIT-SUMMARY.
|
|
|
|
MOVE WS-HASH-INPUT TO AL-HASH-IN.
|
|
MOVE WS-HASH-OUTPUT TO AL-HASH-OUT.
|
|
WRITE AUDIT-LINE FROM WS-AUDIT-TOTAL.
|
|
|
|
DISPLAY "25-subprogram: Tests=" WS-TEST-COUNT
|
|
" Pass=" WS-PASS-COUNT " Fail=" WS-FAIL-COUNT.
|
|
|
|
IF WS-FAIL-COUNT > 0
|
|
MOVE "SOME TESTS FAILED — see report" TO REPORT-LINE
|
|
ELSE
|
|
MOVE "ALL TESTS PASSED" TO REPORT-LINE
|
|
END-IF.
|
|
WRITE REPORT-LINE.
|
|
|
|
WRITE AUDIT-LINE FROM WS-AUDIT-FOOTER.
|
|
|
|
8000-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 9000-EXIT — Cleanup and close
|
|
*> ============================================================
|
|
9000-EXIT SECTION.
|
|
9000-START.
|
|
|
|
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 9000-EXIT start'.
|
|
|
|
CLOSE REPORT-FILE.
|
|
IF FS-REPORT NOT = '00'
|
|
DISPLAY 'WARNING: REPORT-FILE close status=' FS-REPORT
|
|
END-IF.
|
|
|
|
CLOSE AUDIT-FILE.
|
|
IF FS-AUDIT NOT = '00'
|
|
DISPLAY 'WARNING: AUDIT-FILE close status=' FS-AUDIT
|
|
END-IF.
|
|
|
|
CLOSE ERROR-FILE.
|
|
IF FS-ERROR NOT = '00'
|
|
DISPLAY 'WARNING: ERROR-FILE close status=' FS-ERROR
|
|
END-IF.
|
|
|
|
DISPLAY "Report written to sub-report.txt".
|
|
IF WS-ERROR-COUNT > 0
|
|
DISPLAY 'Errors=' WS-ERROR-COUNT
|
|
' — see error-report-25.txt'
|
|
END-IF.
|
|
|
|
DISPLAY "25-subprogram: PASS".
|
|
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' END'.
|
|
STOP RUN.
|
|
|
|
9000-EXIT-EXIT.
|
|
EXIT.
|
|
|
|
END PROGRAM Main25Subprogram.
|