309 lines
6.5 KiB
COBOL
309 lines
6.5 KiB
COBOL
IDENTIFICATION DIVISION.
|
|
PROGRAM-ID. TEST21.
|
|
ENVIRONMENT DIVISION.
|
|
CONFIGURATION SECTION.
|
|
* SPECIAL-NAMES.
|
|
* DECIMAL-POINT IS PERIOD.
|
|
* INPUT-OUTPUT SECTION.
|
|
* FILE-CONTROL.
|
|
DATA DIVISION.
|
|
FILE SECTION.
|
|
WORKING-STORAGE SECTION.
|
|
|
|
01 WS-IDX PIC 9(3).
|
|
01 WS-IDX1 PIC 9(3).
|
|
01 WS-IDX2 PIC 9(3).
|
|
01 IDX PIC 9(3).
|
|
01 IDX2 PIC 9(3) COMP.
|
|
* 01 IDX1 PIC 9(3).
|
|
01 WS-RCODE PIC Z(4)9 VALUE ZERO.
|
|
|
|
01 WS-TABLE1-ENTRIES.
|
|
05 FILLER PIC X(20) VALUE '001MIS '.
|
|
05 FILLER PIC X(20) VALUE '002PAYROLL '.
|
|
05 FILLER PIC X(20) VALUE '003SALES '.
|
|
05 FILLER PIC X(20) VALUE '004SHIPPING '.
|
|
05 FILLER PIC X(20) VALUE '005ACCOUNTING '.
|
|
05 FILLER PIC X(20) VALUE '006DEPT1 '.
|
|
05 FILLER PIC X(20) VALUE '007DEPT2 '.
|
|
05 FILLER PIC X(20) VALUE '008DEPT3 '.
|
|
05 FILLER PIC X(20) VALUE '009DEPT4 '.
|
|
05 FILLER PIC X(20) VALUE '010OTHERS '.
|
|
01 WS-TABLE1 REDEFINES WS-TABLE1-ENTRIES.
|
|
05 WS-TABLE1-ENTRY OCCURS 10 TIMES INDEXED BY IDX1.
|
|
10 WS-TABLE1-IDX PIC 9(3).
|
|
10 WS-TABLE1-DATA PIC X(17).
|
|
|
|
|
|
|
|
PROCEDURE DIVISION.
|
|
|
|
A-000.
|
|
|
|
|
|
DISPLAY "ENTER A-000:".
|
|
DISPLAY "BEGIN: PERFORM TESTS".
|
|
|
|
DISPLAY "BEGIN: IF/ELSE TESTS".
|
|
MOVE 1 TO IDX.
|
|
PERFORM A-100.
|
|
DISPLAY "END : IF/ELSE TESTS".
|
|
|
|
DISPLAY "BEGIN: PERFORM UNTIL TEST".
|
|
MOVE 1 TO IDX.
|
|
PERFORM A-200 THRU A-200-EXIT
|
|
WITH TEST BEFORE UNTIL IDX EQUAL 3.
|
|
DISPLAY "END : PERFORM UNTIL TEST".
|
|
|
|
DISPLAY "BEGIN: PERFORM TIMES TEST".
|
|
MOVE 1 TO IDX.
|
|
PERFORM A-200 THRU A-200-EXIT 3 TIMES.
|
|
DISPLAY "END : PERFORM TIMES TEST".
|
|
|
|
DISPLAY "BEGIN: PERFORM VARYING TEST".
|
|
PERFORM A-300 THRU A-300-EXIT
|
|
VARYING IDX FROM 1 BY 2
|
|
UNTIL IDX EQUAL 5.
|
|
DISPLAY "END : PERFORM VARYING TEST".
|
|
|
|
DISPLAY "BEGIN: PERFORM (in-line) TEST".
|
|
MOVE 1 TO IDX.
|
|
PERFORM
|
|
IF IDX EQUAL 1
|
|
THEN
|
|
DISPLAY "IF - IDX =" IDX "."
|
|
ELSE
|
|
DISPLAY "ELSE - IDX =" IDX "."
|
|
END-IF
|
|
ADD 1 TO IDX
|
|
END-PERFORM.
|
|
DISPLAY "END : PERFORM (in-line) TEST".
|
|
|
|
DISPLAY "BEGIN: PERFORM (in-line) TIMES TEST".
|
|
MOVE 1 TO IDX.
|
|
PERFORM 3 TIMES
|
|
IF IDX EQUAL 1
|
|
THEN
|
|
DISPLAY "IF - IDX =" IDX "."
|
|
ELSE
|
|
DISPLAY "ELSE - IDX =" IDX "."
|
|
END-IF
|
|
ADD 1 TO IDX
|
|
END-PERFORM.
|
|
DISPLAY "END : PERFORM (in-line) TIMES TEST".
|
|
|
|
DISPLAY "BEGIN: PERFORM (in-line) UNTIL TEST".
|
|
MOVE 1 TO IDX.
|
|
PERFORM UNTIL IDX EQUAL 3
|
|
IF IDX EQUAL 1
|
|
THEN
|
|
DISPLAY "IF - IDX =" IDX "."
|
|
ELSE
|
|
DISPLAY "ELSE - IDX =" IDX "."
|
|
END-IF
|
|
ADD 1 TO IDX
|
|
END-PERFORM.
|
|
DISPLAY "END : PERFORM (in-line) UNTIL TEST".
|
|
|
|
DISPLAY "BEGIN: PERFORM (in-line) VARYING TEST".
|
|
PERFORM VARYING IDX FROM 1 BY 2
|
|
UNTIL IDX EQUAL 5
|
|
DISPLAY "IF/ELSE - IDX =" IDX "."
|
|
PERFORM A-300 THRU A-300-EXIT
|
|
* END-PERFORM
|
|
END-PERFORM.
|
|
DISPLAY "END : PERFORM (in-line) VARYING TEST".
|
|
|
|
DISPLAY "BEGIN: PERFORM (in-line) VARYING, CONTINUE TEST".
|
|
PERFORM VARYING IDX FROM 1 BY 2
|
|
UNTIL IDX EQUAL 5
|
|
CONTINUE
|
|
END-PERFORM.
|
|
DISPLAY "PERFORM (in-line) VARYING, CONTINUE - IDX =" IDX ".".
|
|
DISPLAY "END : PERFORM (in-line) VARYING, CONTINUE TEST".
|
|
|
|
DISPLAY "BEGIN: PERFORM (nested in-line) UNTIL TEST".
|
|
MOVE 1 TO IDX.
|
|
PERFORM UNTIL IDX EQUAL 3
|
|
PERFORM
|
|
ADD 1 TO IDX
|
|
END-PERFORM
|
|
END-PERFORM.
|
|
DISPLAY "PERFORM (nested in-line) UNTIL - IDX =" IDX ".".
|
|
DISPLAY "END : PERFORM (nested in-line) UNTIL TEST".
|
|
|
|
DISPLAY "END : PERFORM TESTS".
|
|
|
|
DISPLAY "BEGIN: SEARCH TEST".
|
|
PERFORM A-995.
|
|
DISPLAY "END : SEARCH TEST".
|
|
|
|
MOVE RETURN-CODE TO WS-RCODE.
|
|
DISPLAY "WS-RCODE=" WS-RCODE.
|
|
|
|
DISPLAY "EXIT A-000:".
|
|
STOP RUN.
|
|
|
|
|
|
A-100.
|
|
|
|
DISPLAY "ENTER A-100:".
|
|
|
|
MOVE 99 TO WS-IDX.
|
|
MOVE 1 TO WS-IDX1.
|
|
MOVE 2 TO WS-IDX2.
|
|
DISPLAY "A-100: WS-IDX1 ==" WS-IDX1 " WS-IDX2 ==" WS-IDX2 " WS-IDX ==" WS-IDX.
|
|
|
|
IF ( WS-IDX1 EQUAL 1 ) AND ( WS-IDX2 EQUAL 2 )
|
|
THEN
|
|
DISPLAY "TEST1 (True): WS-IDX1 == 1 AND WS-IDX2 == 2"
|
|
ELSE
|
|
DISPLAY "TEST1 (False): WS-IDX1 != 1 OR WS-IDX2 != 2"
|
|
END-IF.
|
|
|
|
IF WS-IDX1 EQUAL 3
|
|
DISPLAY "TEST2 (True): WS-IDX1 == 3"
|
|
ELSE
|
|
DISPLAY "TEST2 (False): WS-IDX1 != 3"
|
|
END-IF.
|
|
|
|
IF WS-IDX EQUAL 99
|
|
DISPLAY "TEST3 (True): WS-IDX == 99"
|
|
ELSE
|
|
DISPLAY "TEST3 (False): WS-IDX != 99".
|
|
|
|
* Note: This implementation of CONTINUE statement does not
|
|
* conform to the ANSI85 standard.
|
|
* IF WS-IDX NOT EQUAL 99
|
|
IF WS-IDX EQUAL 99
|
|
DISPLAY "TEST3-1 (True): WS-IDX == 99"
|
|
* NEXT SENTENCE
|
|
* CONTINUE
|
|
ELSE
|
|
* DISPLAY "TEST3-1 (True): WS-IDX == 99"
|
|
NEXT SENTENCE
|
|
END-IF.
|
|
|
|
DISPLAY "EXIT A-100".
|
|
|
|
A-200.
|
|
|
|
DISPLAY "ENTER A-200".
|
|
DISPLAY "IDX =" IDX ".".
|
|
ADD 1 TO IDX
|
|
DISPLAY "EXIT A-200".
|
|
|
|
A-200-EXIT.
|
|
|
|
DISPLAY "ENTER A-200-EXIT".
|
|
DISPLAY "EXIT A-200-EXIT".
|
|
|
|
A-300.
|
|
|
|
DISPLAY "ENTER A-300".
|
|
DISPLAY "IDX =" IDX ".".
|
|
DISPLAY "EXIT A-300".
|
|
|
|
A-300-EXIT.
|
|
|
|
DISPLAY "ENTER A-300-EXIT".
|
|
DISPLAY "EXIT A-300-EXIT".
|
|
|
|
A-995.
|
|
|
|
DISPLAY "ENTER A-995:".
|
|
MOVE 3 TO WS-IDX1.
|
|
PERFORM A-1000.
|
|
MOVE 33 TO WS-IDX1.
|
|
PERFORM A-1000.
|
|
MOVE 3 TO WS-IDX1.
|
|
PERFORM A-1010.
|
|
MOVE 33 TO WS-IDX1.
|
|
PERFORM A-1010.
|
|
DISPLAY "EXIT A-995".
|
|
|
|
A-995-EXIT.
|
|
|
|
A-1000.
|
|
|
|
DISPLAY "ENTER A-1000".
|
|
|
|
SET IDX1 TO 1.
|
|
* SET IDX2 TO 1.
|
|
* MOVE 1 TO IDX1.
|
|
|
|
SEARCH WS-TABLE1-ENTRY
|
|
* VARYING IDX2
|
|
AT END PERFORM A-1400
|
|
WHEN WS-IDX1 = WS-TABLE1-IDX (IDX1)
|
|
* WHEN WS-IDX1 = WS-TABLE1-IDX (IDX2)
|
|
* NEXT SENTENCE.
|
|
MOVE 0 TO WS-IDX
|
|
PERFORM A-1300
|
|
END-SEARCH.
|
|
|
|
DISPLAY "EXIT A-1000".
|
|
|
|
A-1010.
|
|
|
|
DISPLAY "ENTER A-1010".
|
|
|
|
* SET IDX1 TO 1.
|
|
SET IDX2 TO 1.
|
|
* MOVE 1 TO IDX1.
|
|
|
|
SEARCH WS-TABLE1-ENTRY
|
|
VARYING IDX2
|
|
AT END PERFORM A-1410
|
|
* WHEN WS-IDX1 = WS-TABLE1-IDX (IDX1)
|
|
WHEN WS-IDX1 = WS-TABLE1-IDX (IDX2)
|
|
* NEXT SENTENCE.
|
|
MOVE 0 TO WS-IDX
|
|
PERFORM A-1310.
|
|
|
|
DISPLAY "EXIT A-1010".
|
|
|
|
A-1300.
|
|
|
|
DISPLAY "ENTER A-1300".
|
|
|
|
MOVE IDX1 TO WS-RCODE.
|
|
DISPLAY "Data found ... IDX1=" WS-RCODE.
|
|
DISPLAY "WS-TABLE1-IDX =" WS-TABLE1-IDX (IDX1) ":".
|
|
DISPLAY "WS-TABLE1-DATA =" WS-TABLE1-DATA (IDX1) ":".
|
|
|
|
DISPLAY "EXIT A-1300".
|
|
|
|
A-1310.
|
|
|
|
DISPLAY "ENTER A-1310".
|
|
|
|
MOVE IDX2 TO WS-RCODE.
|
|
DISPLAY "Data found ... IDX2=" WS-RCODE.
|
|
DISPLAY "WS-TABLE1-IDX =" WS-TABLE1-IDX (IDX2) ":".
|
|
DISPLAY "WS-TABLE1-DATA =" WS-TABLE1-DATA (IDX2) ":".
|
|
|
|
DISPLAY "EXIT A-1310".
|
|
|
|
|
|
A-1400.
|
|
|
|
DISPLAY "ENTER A-1400".
|
|
|
|
DISPLAY "Data WS-IDX1 =" WS-IDX1 " not found in table WS-TABLE1".
|
|
MOVE IDX1 TO WS-RCODE.
|
|
DISPLAY "Index max IDX1 =" WS-RCODE.
|
|
|
|
DISPLAY "EXIT A-1400".
|
|
|
|
A-1410.
|
|
|
|
DISPLAY "ENTER A-1410".
|
|
|
|
DISPLAY "Data WS-IDX1 =" WS-IDX1 " not found in table WS-TABLE1".
|
|
MOVE IDX2 TO WS-RCODE.
|
|
DISPLAY "Index max IDX2 =" WS-RCODE.
|
|
|
|
DISPLAY "EXIT A-1410".
|
|
|