IDENTIFICATION DIVISION. PROGRAM-ID. RRDSTest. *> RELATIVE(RRDS)文件編成測試 *> Coverage: FO-N004, FO-A003, FO-R001 ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT RRDS-FILE ASSIGN TO "RRDS.DAT" ORGANIZATION IS RELATIVE ACCESS MODE IS RANDOM RELATIVE KEY IS WS-RRN FILE STATUS IS WS-FS. DATA DIVISION. FILE SECTION. FD RRDS-FILE RECORD CONTAINS 40 CHARACTERS. 01 RRDS-REC. 05 RR-KEY PIC X(10). 05 RR-DATA PIC X(30). WORKING-STORAGE SECTION. 01 WS-FS PIC X(2). 01 WS-RRN PIC 9(5). 01 WS-I PIC 9(3). 01 WS-PASS PIC 9(2) VALUE 0. 01 WS-FAIL PIC 9(2) VALUE 0. PROCEDURE DIVISION. MAIN. DISPLAY "RRDS-TEST: Starting RELATIVE file test" *> FO-N004: RRN指定WRITE OPEN OUTPUT RRDS-FILE. IF WS-FS NOT = "00" DISPLAY "OPEN OUTPUT FAIL: STATUS=" WS-FS STOP RUN RETURNING 1 END-IF. DISPLAY "FO-N004: OPEN OUTPUT STATUS=" WS-FS MOVE 1 TO WS-RRN. MOVE "RRN-00001" TO RR-KEY. MOVE "WRITE AT RRN 1" TO RR-DATA. WRITE RRDS-REC. IF WS-FS = "00" ADD 1 TO WS-PASS DISPLAY "FO-N004-1: WRITE RRN=1 PASS" ELSE ADD 1 TO WS-FAIL DISPLAY "FO-N004-1: WRITE FAIL STATUS=" WS-FS END-IF. MOVE 5 TO WS-RRN. MOVE "RRN-00005" TO RR-KEY. MOVE "WRITE AT RRN 5" TO RR-DATA. WRITE RRDS-REC. IF WS-FS = "00" ADD 1 TO WS-PASS DISPLAY "FO-N004-2: WRITE RRN=5 PASS" ELSE ADD 1 TO WS-FAIL DISPLAY "FO-N004-2: WRITE FAIL STATUS=" WS-FS END-IF. MOVE 10 TO WS-RRN. MOVE "RRN-00010" TO RR-KEY. MOVE "WRITE AT RRN 10" TO RR-DATA. WRITE RRDS-REC. IF WS-FS = "00" ADD 1 TO WS-PASS DISPLAY "FO-N004-3: WRITE RRN=10 PASS" ELSE ADD 1 TO WS-FAIL DISPLAY "FO-N004-3: WRITE FAIL STATUS=" WS-FS END-IF. CLOSE RRDS-FILE. *> FO-N004: RRN指定READ OPEN INPUT RRDS-FILE. MOVE 5 TO WS-RRN. READ RRDS-FILE INTO RRDS-REC INVALID KEY ADD 1 TO WS-FAIL DISPLAY "FO-N004-4: READ RRN=5 FAIL" NOT INVALID KEY ADD 1 TO WS-PASS DISPLAY "FO-N004-4: READ RRN=5 PASS: " RR-KEY END-READ. CLOSE RRDS-FILE. *> FO-A003: 範囲外RRNアクセス OPEN INPUT RRDS-FILE. MOVE 999 TO WS-RRN. READ RRDS-FILE INTO RRDS-REC INVALID KEY ADD 1 TO WS-PASS DISPLAY "FO-A003: PASS - OUT OF RANGE RRN=999" NOT INVALID KEY ADD 1 TO WS-FAIL DISPLAY "FO-A003: FAIL - RRN=999 read unexpected" END-READ. CLOSE RRDS-FILE. *> FO-R001: FILE STATUS確認 DISPLAY "FO-R001: File status codes" IF WS-FS = "23" OR "00" DISPLAY "FO-R001: STATUS=" WS-FS " checked" END-IF. DISPLAY " " DISPLAY "RRDS-TEST: PASS=" WS-PASS " FAIL=" WS-FAIL IF WS-FAIL = 0 DISPLAY "RRDS-TEST: ALL PASSED" STOP RUN RETURNING 0 ELSE DISPLAY "RRDS-TEST: FAILED" STOP RUN RETURNING 1 END-IF . END PROGRAM RRDSTest.