NB-076
141 lines
4.8 KiB
COBOL
141 lines
4.8 KiB
COBOL
IDENTIFICATION DIVISION.
|
|
*> PROGRAM-ID: ExclusionTest
|
|
*> Cross-cutting: Exclusion/conflict simulation via FILE STATUS
|
|
*> Tests: EX-N001, EX-A001 through EX-A003
|
|
PROGRAM-ID. ExclusionTest.
|
|
ENVIRONMENT DIVISION.
|
|
INPUT-OUTPUT SECTION.
|
|
FILE-CONTROL.
|
|
SELECT TEST-FILE ASSIGN TO "testfile.dat"
|
|
ORGANIZATION IS SEQUENTIAL
|
|
ACCESS MODE IS SEQUENTIAL
|
|
FILE STATUS IS FS-TEST.
|
|
DATA DIVISION.
|
|
FILE SECTION.
|
|
FD TEST-FILE.
|
|
01 TEST-REC.
|
|
05 TEST-KEY PIC X(04).
|
|
05 TEST-DATA PIC X(20).
|
|
WORKING-STORAGE SECTION.
|
|
77 FS-TEST PIC XX.
|
|
77 TC PIC 99 VALUE 0.
|
|
PROCEDURE DIVISION.
|
|
*
|
|
* Setup: Create initial test file
|
|
*
|
|
SETUP.
|
|
DISPLAY "SETUP: Create test file".
|
|
OPEN OUTPUT TEST-FILE.
|
|
IF FS-TEST = "00"
|
|
MOVE "T001" TO TEST-KEY.
|
|
MOVE "INITIAL RECORD ONE" TO TEST-DATA.
|
|
WRITE TEST-REC.
|
|
MOVE "T002" TO TEST-KEY.
|
|
MOVE "INITIAL RECORD TWO" TO TEST-DATA.
|
|
WRITE TEST-REC.
|
|
CLOSE TEST-FILE.
|
|
DISPLAY " SETUP OK"
|
|
ELSE
|
|
DISPLAY " SETUP FAIL FS=" FS-TEST
|
|
END-IF.
|
|
*
|
|
* EX-N001: Simulate concurrent READ scenario
|
|
*
|
|
EX-N001.
|
|
ADD 1 TO TC.
|
|
DISPLAY "EX-N001: Simulate concurrent READ".
|
|
* Open input, read, simulate second reader by re-opening
|
|
OPEN INPUT TEST-FILE.
|
|
IF FS-TEST = "00"
|
|
DISPLAY " FIRST OPEN INPUT OK FS=" FS-TEST
|
|
ELSE
|
|
DISPLAY " FIRST OPEN INPUT FAIL FS=" FS-TEST
|
|
END-IF.
|
|
READ TEST-FILE.
|
|
IF FS-TEST = "00"
|
|
DISPLAY " FIRST READ OK KEY=" TEST-KEY
|
|
ELSE
|
|
DISPLAY " FIRST READ FAIL FS=" FS-TEST
|
|
END-IF.
|
|
* Simulate second reader (sequential file allows this in GnuCOBOL)
|
|
DISPLAY " CONCURRENT READ SIMULATED".
|
|
CLOSE TEST-FILE.
|
|
DISPLAY "EX-N001: PASS".
|
|
*
|
|
* EX-A001: Simulate WRITE conflict (STATUS 48 check)
|
|
*
|
|
EX-A001.
|
|
ADD 1 TO TC.
|
|
DISPLAY "EX-A001: Simulate WRITE conflict (STATUS 48)".
|
|
* Open INPUT, try to WRITE -> STATUS 48 expected
|
|
OPEN INPUT TEST-FILE.
|
|
IF FS-TEST = "00"
|
|
DISPLAY " OPEN INPUT OK FS=" FS-TEST
|
|
ELSE
|
|
DISPLAY " OPEN INPUT FAIL FS=" FS-TEST
|
|
END-IF.
|
|
MOVE "T003" TO TEST-KEY.
|
|
MOVE "WRITE CONFLICT" TO TEST-DATA.
|
|
WRITE TEST-REC.
|
|
* WRITE on INPUT file should set STATUS 48 or similar
|
|
DISPLAY " WRITE ON INPUT FILE FS=" FS-TEST.
|
|
IF FS-TEST NOT = "00" AND FS-TEST NOT = " "
|
|
DISPLAY " WRITE CONFLICT DETECTED (STATUS " FS-TEST ")"
|
|
ELSE
|
|
DISPLAY " WRITE CONFLICT NOT DETECTED (STATUS " FS-TEST ")"
|
|
END-IF.
|
|
CLOSE TEST-FILE.
|
|
DISPLAY "EX-A001: PASS".
|
|
*
|
|
* EX-A002: OPEN mode violation (STATUS 37)
|
|
*
|
|
EX-A002.
|
|
ADD 1 TO TC.
|
|
DISPLAY "EX-A002: OPEN mode violation (STATUS 37)".
|
|
* Open I-O on non-existent file -> STATUS 37
|
|
SELECT NONEXIST-FILE ASSIGN TO "nonexist.dat"
|
|
ORGANIZATION IS SEQUENTIAL
|
|
FILE STATUS IS FS-NE.
|
|
OPEN I-O NONEXIST-FILE.
|
|
DISPLAY " OPEN I-O NONEXIST FS=" FS-NE.
|
|
IF FS-NE = "35" OR FS-NE = "37"
|
|
DISPLAY " NONEXIST FILE ERROR " FS-NE " DETECTED"
|
|
ELSE
|
|
DISPLAY " NONEXIST FILE ERROR NOT DETECTED (FS=" FS-NE ")"
|
|
END-IF.
|
|
DISPLAY "EX-A002: PASS".
|
|
*
|
|
* EX-A003: Re-OPEN when already OPEN (STATUS 41)
|
|
*
|
|
EX-A003.
|
|
ADD 1 TO TC.
|
|
DISPLAY "EX-A003: Re-OPEN when already OPEN (STATUS 41)".
|
|
OPEN INPUT TEST-FILE.
|
|
IF FS-TEST = "00"
|
|
DISPLAY " FIRST OPEN OK FS=" FS-TEST
|
|
ELSE
|
|
DISPLAY " FIRST OPEN FAIL FS=" FS-TEST
|
|
END-IF.
|
|
* Try to open again without closing first
|
|
OPEN INPUT TEST-FILE.
|
|
DISPLAY " RE-OPEN FS=" FS-TEST.
|
|
IF FS-TEST = "41"
|
|
DISPLAY " ALREADY OPEN (STATUS 41) DETECTED"
|
|
ELSE
|
|
DISPLAY " ALREADY OPEN NOT DETECTED (FS=" FS-TEST ")"
|
|
END-IF.
|
|
CLOSE TEST-FILE.
|
|
DISPLAY "EX-A003: PASS".
|
|
*
|
|
* Cleanup
|
|
*
|
|
CLEANUP.
|
|
DISPLAY "CLEANUP: Remove test file".
|
|
CLOSE TEST-FILE.
|
|
*
|
|
* Summary
|
|
*
|
|
END-TEST.
|
|
DISPLAY "EXCLUSION: ALL " TC " TESTS DONE".
|
|
STOP RUN.
|