cobol-java-v3/benchmark-programs/cross-cutting/file-organization/main-rrds-test.cbl

       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.