|
000100 IDENTIFICATION DIVISION. IC2274.2
000200 PROGRAM-ID. IC2274.2
000300 IC227A. IC2274.2
000400**************************************************************** IC2274.2
000500* * IC2274.2
000600* VALIDATION FOR:- * IC2274.2
000700* * IC2274.2
000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2274.2
000900* * IC2274.2
001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2274.2
001100* * IC2274.2
001200**************************************************************** IC2274.2
001300* * IC2274.2
001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2274.2
001500* * IC2274.2
001600* X-55 SYSTEM PRINTER * IC2274.2
001700* X-82 SOURCE-COMPUTER * IC2274.2
001800* X-83 OBJECT-COMPUTER. * IC2274.2
001900* * IC2274.2
002000**************************************************************** IC2274.2
002100* * IC2274.2
002200* PROGRAMS IC227A AND IC227A-1 TEST LEVEL 2 LANGUAGE * IC2274.2
002300* ELEMENTS FROM THE INTER-PROGRAM COMMUNICATION MODULE. * IC2274.2
002400* THE PARTICULAR ELEMENTS TESTED ARE: * IC2274.2
002500* THE "EXTERNAL" CLAUSE IN THE FILE DESCRIPTION ENTRY * IC2274.2
002600* * IC2274.2
002700* ALTHOUGH IC227A AND IC227A-1 ARE SEPARATELY COMPILED * IC2274.2
002800* PROGRAMS, BOTH ARE INTENDED TO BE COMPILED BY THE SAME * IC2274.2
002900* INVOCATION OF THE COMPILER, IN ORDER TO TEST STREAM * IC2274.2
003000* COMPILATION AND RECOGNITION OF THE END PROGRAM HEADER. * IC2274.2
003100* * IC2274.2
003200* THE STRUCTURE OF THE SOURCE FILE IS: IC2274.2
003300* * IC2274.2
003400* IDENTIFICATION DIVISION. * IC2274.2
003500* PROGRAM-ID. IC227A. * IC2274.2
003600* . * IC2274.2
003700* . * IC2274.2
003800* . * IC2274.2
003900* END PROGRAM IC227A. * IC2274.2
004000* IDENTIFICATION DIVISION. * IC2274.2
004100* PROGRAM-ID. IC227A-1. * IC2274.2
004200* . * IC2274.2
004300* . * IC2274.2
004400* . * IC2274.2
004500* END PROGRAM IC227A-1. * IC2274.2
004600* * IC2274.2
004700**************************************************************** IC2274.2
004800* IC2274.2
004900 ENVIRONMENT DIVISION. IC2274.2
005000 CONFIGURATION SECTION. IC2274.2
005100 SOURCE-COMPUTER. IC2274.2
005200 Card0130. IC2274.2
005300 OBJECT-COMPUTER. IC2274.2
005400 Card0131. IC2274.2
005500* IC2274.2
005600 INPUT-OUTPUT SECTION. IC2274.2
005700 FILE-CONTROL. IC2274.2
005800 SELECT PRINT-FILE ASSIGN TO IC2274.2
005900 "C0085" . IC2274.2
006000* IC2274.2
006100 SELECT EXTERNAL-FILE ASSIGN TO IC2274.2
006200 "C0020" IC2274.2
006300 FILE STATUS IS EXTERNAL-FILE-FS. IC2274.2
006400* IC2274.2
006500 DATA DIVISION. IC2274.2
006600 FILE SECTION. IC2274.2
006700 FD PRINT-FILE. IC2274.2
006800 01 PRINT-REC PICTURE X(120). IC2274.2
006900 01 DUMMY-RECORD PICTURE X(120). IC2274.2
007000* IC2274.2
007100 FD EXTERNAL-FILE IC2274.2
007200 IS EXTERNAL IC2274.2
007300 RECORD CONTAINS 18 CHARACTERS. IC2274.2
007400 01 EXTERNAL-FILE-RECORD. IC2274.2
007500 03 EXT-DATA-1 PIC X(2). IC2274.2
007600 03 EXT-DATA-2 PIC X(6). IC2274.2
007700 03 EXT-DATA-3 PIC 9(6). IC2274.2
007800 03 EXT-DATA-4 PIC 9(4). IC2274.2
007900* IC2274.2
008000 WORKING-STORAGE SECTION. IC2274.2
008100* IC2274.2
008200*************************************************************** IC2274.2
008300* * IC2274.2
008400* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * IC2274.2
008500* * IC2274.2
008600*************************************************************** IC2274.2
008700* IC2274.2
008800 01 EXTERNAL-RECORD-HOLD. IC2274.2
008900 03 WSE-DATA-1 PIC X(2). IC2274.2
009000 03 WSE-DATA-2 PIC X(6). IC2274.2
009100 03 WSE-DATA-3 PIC 9(6). IC2274.2
009200 03 WSE-DATA-4 PIC 9(4). IC2274.2
009300* IC2274.2
009400 01 EXTERNAL-RECORD-WORK. IC2274.2
009500 03 WRK-DATA-1 PIC X(2). IC2274.2
009600 03 WRK-DATA-2 PIC X(6). IC2274.2
009700 03 WRK-DATA-3 PIC 9(6). IC2274.2
009800 03 WRK-DATA-4 PIC 9(4). IC2274.2
009900* IC2274.2
010000 01 EXTERNAL-FILE-FS PIC XX. IC2274.2
010100 01 F-S-PARAM PIC XX. IC2274.2
010200 01 ACTION-CODE PIC 99. IC2274.2
010300 77 ID1 PICTURE X(8) VALUE "IC227A-1". IC2274.2
010400* IC2274.2
010500*************************************************************** IC2274.2
010600* * IC2274.2
010700* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * IC2274.2
010800* * IC2274.2
010900*************************************************************** IC2274.2
011000* IC2274.2
011100 01 TEST-RESULTS. IC2274.2
011200 02 FILLER PIC X VALUE SPACE. IC2274.2
011300 02 FEATURE PIC X(20) VALUE SPACE. IC2274.2
011400 02 FILLER PIC X VALUE SPACE. IC2274.2
011500 02 P-OR-F PIC X(5) VALUE SPACE. IC2274.2
011600 02 FILLER PIC X VALUE SPACE. IC2274.2
011700 02 PAR-NAME. IC2274.2
011800 03 FILLER PIC X(19) VALUE SPACE. IC2274.2
011900 03 PARDOT-X PIC X VALUE SPACE. IC2274.2
012000 03 DOTVALUE PIC 99 VALUE ZERO. IC2274.2
012100 02 FILLER PIC X(8) VALUE SPACE. IC2274.2
012200 02 RE-MARK PIC X(61). IC2274.2
012300 01 TEST-COMPUTED. IC2274.2
012400 02 FILLER PIC X(30) VALUE SPACE. IC2274.2
012500 02 FILLER PIC X(17) VALUE IC2274.2
012600 " COMPUTED=". IC2274.2
012700 02 COMPUTED-X. IC2274.2
012800 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2274.2
012900 03 COMPUTED-N REDEFINES COMPUTED-A IC2274.2
013000 PIC -9(9).9(9). IC2274.2
013100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2274.2
013200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2274.2
013300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2274.2
013400 03 CM-18V0 REDEFINES COMPUTED-A. IC2274.2
013500 04 COMPUTED-18V0 PIC -9(18). IC2274.2
013600 04 FILLER PIC X. IC2274.2
013700 03 FILLER PIC X(50) VALUE SPACE. IC2274.2
013800 01 TEST-CORRECT. IC2274.2
013900 02 FILLER PIC X(30) VALUE SPACE. IC2274.2
014000 02 FILLER PIC X(17) VALUE " CORRECT =". IC2274.2
014100 02 CORRECT-X. IC2274.2
014200 03 CORRECT-A PIC X(20) VALUE SPACE. IC2274.2
014300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2274.2
014400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2274.2
014500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2274.2
014600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2274.2
014700 03 CR-18V0 REDEFINES CORRECT-A. IC2274.2
014800 04 CORRECT-18V0 PIC -9(18). IC2274.2
014900 04 FILLER PIC X. IC2274.2
015000 03 FILLER PIC X(2) VALUE SPACE. IC2274.2
015100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2274.2
015200 01 CCVS-C-1. IC2274.2
015300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2274.2
015400- "SS PARAGRAPH-NAME IC2274.2
015500- " REMARKS". IC2274.2
015600 02 FILLER PIC X(20) VALUE SPACE. IC2274.2
015700 01 CCVS-C-2. IC2274.2
015800 02 FILLER PIC X VALUE SPACE. IC2274.2
015900 02 FILLER PIC X(6) VALUE "TESTED". IC2274.2
016000 02 FILLER PIC X(15) VALUE SPACE. IC2274.2
016100 02 FILLER PIC X(4) VALUE "FAIL". IC2274.2
016200 02 FILLER PIC X(94) VALUE SPACE. IC2274.2
016300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2274.2
016400 01 REC-CT PIC 99 VALUE ZERO. IC2274.2
016500 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2274.2
016600 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2274.2
016700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2274.2
016800 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2274.2
016900 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2274.2
017000 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2274.2
017100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2274.2
017200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2274.2
017300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2274.2
017400 01 CCVS-H-1. IC2274.2
017500 02 FILLER PIC X(39) VALUE SPACES. IC2274.2
017600 02 FILLER PIC X(42) VALUE IC2274.2
017700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2274.2
017800 02 FILLER PIC X(39) VALUE SPACES. IC2274.2
017900 01 CCVS-H-2A. IC2274.2
018000 02 FILLER PIC X(40) VALUE SPACE. IC2274.2
018100 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2274.2
018200 02 FILLER PIC XXXX VALUE IC2274.2
018300 "4.2 ". IC2274.2
018400 02 FILLER PIC X(28) VALUE IC2274.2
018500 " COPY - NOT FOR DISTRIBUTION". IC2274.2
018600 02 FILLER PIC X(41) VALUE SPACE. IC2274.2
018700 IC2274.2
018800 01 CCVS-H-2B. IC2274.2
018900 02 FILLER PIC X(15) VALUE IC2274.2
019000 "TEST RESULT OF ". IC2274.2
019100 02 TEST-ID PIC X(9). IC2274.2
019200 02 FILLER PIC X(4) VALUE IC2274.2
019300 " IN ". IC2274.2
019400 02 FILLER PIC X(12) VALUE IC2274.2
019500 " HIGH ". IC2274.2
019600 02 FILLER PIC X(22) VALUE IC2274.2
019700 " LEVEL VALIDATION FOR ". IC2274.2
019800 02 FILLER PIC X(58) VALUE IC2274.2
019900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2274.2
020000 01 CCVS-H-3. IC2274.2
020100 02 FILLER PIC X(34) VALUE IC2274.2
020200 " FOR OFFICIAL USE ONLY ". IC2274.2
020300 02 FILLER PIC X(58) VALUE IC2274.2
020400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2274.2
020500 02 FILLER PIC X(28) VALUE IC2274.2
020600 " COPYRIGHT 1985,1986 ". IC2274.2
020700 01 CCVS-E-1. IC2274.2
020800 02 FILLER PIC X(52) VALUE SPACE. IC2274.2
020900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2274.2
021000 02 ID-AGAIN PIC X(9). IC2274.2
021100 02 FILLER PIC X(45) VALUE SPACES. IC2274.2
021200 01 CCVS-E-2. IC2274.2
021300 02 FILLER PIC X(31) VALUE SPACE. IC2274.2
021400 02 FILLER PIC X(21) VALUE SPACE. IC2274.2
021500 02 CCVS-E-2-2. IC2274.2
021600 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2274.2
021700 03 FILLER PIC X VALUE SPACE. IC2274.2
021800 03 ENDER-DESC PIC X(44) VALUE IC2274.2
021900 "ERRORS ENCOUNTERED". IC2274.2
022000 01 CCVS-E-3. IC2274.2
022100 02 FILLER PIC X(22) VALUE IC2274.2
022200 " FOR OFFICIAL USE ONLY". IC2274.2
022300 02 FILLER PIC X(12) VALUE SPACE. IC2274.2
022400 02 FILLER PIC X(58) VALUE IC2274.2
022500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2274.2
022600 02 FILLER PIC X(8) VALUE SPACE. IC2274.2
022700 02 FILLER PIC X(20) VALUE IC2274.2
022800 " COPYRIGHT 1985,1986". IC2274.2
022900 01 CCVS-E-4. IC2274.2
023000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2274.2
023100 02 FILLER PIC X(4) VALUE " OF ". IC2274.2
023200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2274.2
023300 02 FILLER PIC X(40) VALUE IC2274.2
023400 " TESTS WERE EXECUTED SUCCESSFULLY". IC2274.2
023500 01 XXINFO. IC2274.2
023600 02 FILLER PIC X(19) VALUE IC2274.2
023700 "*** INFORMATION ***". IC2274.2
023800 02 INFO-TEXT. IC2274.2
023900 04 FILLER PIC X(8) VALUE SPACE. IC2274.2
024000 04 XXCOMPUTED PIC X(20). IC2274.2
024100 04 FILLER PIC X(5) VALUE SPACE. IC2274.2
024200 04 XXCORRECT PIC X(20). IC2274.2
024300 02 INF-ANSI-REFERENCE PIC X(48). IC2274.2
024400 01 HYPHEN-LINE. IC2274.2
024500 02 FILLER PIC IS X VALUE IS SPACE. IC2274.2
024600 02 FILLER PIC IS X(65) VALUE IS "************************IC2274.2
024700- "*****************************************". IC2274.2
024800 02 FILLER PIC IS X(54) VALUE IS "************************IC2274.2
024900- "******************************". IC2274.2
025000 01 CCVS-PGM-ID PIC X(9) VALUE IC2274.2
025100 "IC227A". IC2274.2
025200* IC2274.2
025300* IC2274.2
025400 PROCEDURE DIVISION. IC2274.2
025500 CCVS1 SECTION. IC2274.2
025600 OPEN-FILES. IC2274.2
025700 OPEN OUTPUT PRINT-FILE. IC2274.2
025800 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2274.2
025900 MOVE SPACE TO TEST-RESULTS. IC2274.2
026000 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2274.2
026100 GO TO CCVS1-EXIT. IC2274.2
026200 CLOSE-FILES. IC2274.2
026300 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2274.2
026400 TERMINATE-CCVS. IC2274.2
026500 STOP RUN. IC2274.2
026600* IC2274.2
026700 INSPT. IC2274.2
026800 MOVE "INSPT" TO P-OR-F. IC2274.2
026900 ADD 1 TO INSPECT-COUNTER. IC2274.2
027000 PERFORM PRINT-DETAIL. IC2274.2
027100 IC2274.2
027200 PASS. IC2274.2
027300 MOVE "PASS " TO P-OR-F. IC2274.2
027400 ADD 1 TO PASS-COUNTER. IC2274.2
027500 PERFORM PRINT-DETAIL. IC2274.2
027600* IC2274.2
027700 FAIL. IC2274.2
027800 MOVE "FAIL*" TO P-OR-F. IC2274.2
027900 ADD 1 TO ERROR-COUNTER. IC2274.2
028000 PERFORM PRINT-DETAIL. IC2274.2
028100* IC2274.2
028200 DE-LETE. IC2274.2
028300 MOVE "****TEST DELETED****" TO RE-MARK. IC2274.2
028400 MOVE "*****" TO P-OR-F. IC2274.2
028500 ADD 1 TO DELETE-COUNTER. IC2274.2
028600 PERFORM PRINT-DETAIL. IC2274.2
028700 IC2274.2
028800 PRINT-DETAIL. IC2274.2
028900 IF REC-CT NOT EQUAL TO ZERO IC2274.2
029000 MOVE "." TO PARDOT-X IC2274.2
029100 MOVE REC-CT TO DOTVALUE. IC2274.2
029200 MOVE TEST-RESULTS TO PRINT-REC. IC2274.2
029300 PERFORM WRITE-LINE. IC2274.2
029400 IF P-OR-F EQUAL TO "FAIL*" IC2274.2
029500 PERFORM WRITE-LINE IC2274.2
029600 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2274.2
029700 ELSE IC2274.2
029800 PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2274.2
029900 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2274.2
030000 MOVE SPACE TO CORRECT-X. IC2274.2
030100 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2274.2
030200 MOVE SPACE TO RE-MARK. IC2274.2
030300* IC2274.2
030400 HEAD-ROUTINE. IC2274.2
030500 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2274.2
030600 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2274.2
030700 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2274.2
030800 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2274.2
030900 COLUMN-NAMES-ROUTINE. IC2274.2
031000 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2274.2
031100 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2274.2
031200 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2274.2
031300 END-ROUTINE. IC2274.2
031400 MOVE HYPHEN-LINE TO DUMMY-RECORD. IC2274.2
031500 PERFORM WRITE-LINE 5 TIMES. IC2274.2
031600 END-RTN-EXIT. IC2274.2
031700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2274.2
031800* IC2274.2
031900 END-ROUTINE-1. IC2274.2
032000 ADD ERROR-COUNTER TO ERROR-HOLD IC2274.2
032100 ADD INSPECT-COUNTER TO ERROR-HOLD. IC2274.2
032200 ADD DELETE-COUNTER TO ERROR-HOLD. IC2274.2
032300 ADD PASS-COUNTER TO ERROR-HOLD. IC2274.2
032400* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2274.2
032500 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2274.2
032600 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2274.2
032700 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2274.2
032800 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2274.2
032900 END-ROUTINE-12. IC2274.2
033000 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2274.2
033100 IF ERROR-COUNTER IS EQUAL TO ZERO IC2274.2
033200 MOVE "NO " TO ERROR-TOTAL IC2274.2
033300 ELSE IC2274.2
033400 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2274.2
033500 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2274.2
033600 PERFORM WRITE-LINE. IC2274.2
033700 END-ROUTINE-13. IC2274.2
033800 IF DELETE-COUNTER IS EQUAL TO ZERO IC2274.2
033900 MOVE "NO " TO ERROR-TOTAL ELSE IC2274.2
034000 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2274.2
034100 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2274.2
034200 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2274.2
034300 IF INSPECT-COUNTER EQUAL TO ZERO IC2274.2
034400 MOVE "NO " TO ERROR-TOTAL IC2274.2
034500 ELSE IC2274.2
034600 MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2274.2
034700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2274.2
034800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2274.2
034900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2274.2
035000* IC2274.2
035100 WRITE-LINE. IC2274.2
035200 ADD 1 TO RECORD-COUNT. IC2274.2
035300 IF RECORD-COUNT GREATER 50 IC2274.2
035400 MOVE DUMMY-RECORD TO DUMMY-HOLD IC2274.2
035500 MOVE SPACE TO DUMMY-RECORD IC2274.2
035600 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2274.2
035700 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2274.2
035800 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2274.2
035900 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2274.2
036000 MOVE DUMMY-HOLD TO DUMMY-RECORD IC2274.2
036100 MOVE ZERO TO RECORD-COUNT. IC2274.2
036200 PERFORM WRT-LN. IC2274.2
036300 WRT-LN. IC2274.2
036400 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2274.2
036500 MOVE SPACE TO DUMMY-RECORD. IC2274.2
036600 BLANK-LINE-PRINT. IC2274.2
036700 PERFORM WRT-LN. IC2274.2
036800 FAIL-ROUTINE. IC2274.2
036900 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2274.2
037000 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2274.2
037100 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2274.2
037200 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2274.2
037300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2274.2
037400 MOVE SPACES TO INF-ANSI-REFERENCE. IC2274.2
037500 GO TO FAIL-ROUTINE-EX. IC2274.2
037600 FAIL-ROUTINE-WRITE. IC2274.2
037700 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2274.2
037800 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2274.2
037900 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2274.2
038000 MOVE SPACES TO COR-ANSI-REFERENCE. IC2274.2
038100 FAIL-ROUTINE-EX. EXIT. IC2274.2
038200 BAIL-OUT. IC2274.2
038300 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2274.2
038400 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2274.2
038500 BAIL-OUT-WRITE. IC2274.2
038600 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2274.2
038700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2274.2
038800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2274.2
038900 MOVE SPACES TO INF-ANSI-REFERENCE. IC2274.2
039000 BAIL-OUT-EX. EXIT. IC2274.2
039100 CCVS1-EXIT. IC2274.2
039200 EXIT. IC2274.2
039300* IC2274.2
039400**************************************************************** IC2274.2
039500* * IC2274.2
039600* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * IC2274.2
039700* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * IC2274.2
039800* * IC2274.2
039900**************************************************************** IC2274.2
040000* IC2274.2
040100 SECT-IC227A-01 SECTION. IC2274.2
040200 EXT-INIT-01. IC2274.2
040300* IC2274.2
040400* ************************************************* IC2274.2
040500* * * IC2274.2
040600* * MAKE EXTERNAL FILE RECORD AREA AVAILABLE * IC2274.2
040700* * * IC2274.2
040800* ************************************************* IC2274.2
040900* IC2274.2
041000 OPEN OUTPUT EXTERNAL-FILE. IC2274.2
041100* IC2274.2
041200 MOVE 1 TO REC-CT. IC2274.2
041300 MOVE "EXTERNAL FILE RECORD" TO FEATURE. IC2274.2
041400 MOVE "X-23 4.5.1" TO ANSI-REFERENCE. IC2274.2
041500 MOVE "EXT-REC-TEST-01" TO PAR-NAME. IC2274.2
041600 MOVE "******************" TO EXTERNAL-FILE-RECORD. IC2274.2
041700 MOVE "**" TO F-S-PARAM. IC2274.2
041800 MOVE "AA" TO WRK-DATA-1 IC2274.2
041900 MOVE "PQRSTU" TO WRK-DATA-2 IC2274.2
042000 MOVE 123456 TO WRK-DATA-3 IC2274.2
042100 MOVE 9876 TO WRK-DATA-4. IC2274.2
042200 MOVE EXTERNAL-RECORD-WORK TO EXTERNAL-RECORD-HOLD. IC2274.2
042300 MOVE "<>" TO EXTERNAL-FILE-FS. IC2274.2
042400 GO TO EXT-REC-TEST-01. IC2274.2
042500 EXT-REC-DELETE-01. IC2274.2
042600 PERFORM DE-LETE. IC2274.2
042700 GO TO EXT-REC-DELETE-01-02. IC2274.2
042800* IC2274.2
042900* ************************************************* IC2274.2
043000* * * IC2274.2
043100* * CHECK THAT SUBPROGRAM SEES SAME RECORD AREA * IC2274.2
043200* * * IC2274.2
043300* ************************************************* IC2274.2
043400* IC2274.2
043500 EXT-REC-TEST-01. IC2274.2
043600 MOVE 1 TO ACTION-CODE. IC2274.2
043700 CALL "IC227A-1" USING ACTION-CODE IC2274.2
043800 EXTERNAL-RECORD-WORK IC2274.2
043900 F-S-PARAM. IC2274.2
044000 IF EXTERNAL-FILE-RECORD EQUAL EXTERNAL-RECORD-HOLD IC2274.2
044100 PERFORM PASS IC2274.2
044200 ELSE IC2274.2
044300 MOVE "SUBPROGRAM DID NOT WRITE TO RECORD AREA" IC2274.2
044400 TO RE-MARK IC2274.2
044500 MOVE EXTERNAL-FILE-RECORD TO COMPUTED-A IC2274.2
044600 MOVE EXTERNAL-RECORD-HOLD TO CORRECT-A IC2274.2
044700 PERFORM FAIL IC2274.2
044800 END-IF. IC2274.2
044900 GO TO EXT-REC-TEST-01-02. IC2274.2
045000 EXT-REC-DELETE-01-02. IC2274.2
045100 ADD 1 TO REC-CT IC2274.2
045200 PERFORM DE-LETE. IC2274.2
045300 GO TO EXT-REC-DELETE-01-03. IC2274.2
045400 EXT-REC-TEST-01-02. IC2274.2
045500 ADD 1 TO REC-CT. IC2274.2
045600 IF EXTERNAL-RECORD-WORK EQUAL "******************" IC2274.2
045700 PERFORM PASS IC2274.2
045800 ELSE IC2274.2
045900 MOVE "SUBPROGRAM DID NOT READ FROM RECORD AREA" IC2274.2
046000 TO RE-MARK IC2274.2
046100 MOVE EXTERNAL-RECORD-WORK TO COMPUTED-A IC2274.2
046200 MOVE "******************" TO CORRECT-A IC2274.2
046300 PERFORM FAIL IC2274.2
046400 END-IF. IC2274.2
046500 GO TO EXT-REC-TEST-01-03. IC2274.2
046600 EXT-REC-DELETE-01-03. IC2274.2
046700 ADD 1 TO REC-CT IC2274.2
046800 PERFORM DE-LETE. IC2274.2
046900 GO TO EXT-REC-TEST-01-END. IC2274.2
047000 EXT-REC-TEST-01-03. IC2274.2
047100 ADD 1 TO REC-CT. IC2274.2
047200 IF F-S-PARAM IS EQUAL "XX" IC2274.2
047300 PERFORM PASS IC2274.2
047400 ELSE IC2274.2
047500 MOVE "WRONG FILE STATUS VALUE RETURNED" IC2274.2
047600 TO RE-MARK IC2274.2
047700 MOVE F-S-PARAM TO COMPUTED-A IC2274.2
047800 MOVE "XX" TO CORRECT-A IC2274.2
047900 PERFORM FAIL IC2274.2
048000 END-IF. IC2274.2
048100 EXT-REC-TEST-01-END. IC2274.2
048200* IC2274.2
048300* IC2274.2
048400 EXT-INIT-02. IC2274.2
048500* IC2274.2
048600* ************************************************* IC2274.2
048700* * * IC2274.2
048800* * WRITE RECORD FROM PARAMETERS TO FILE * IC2274.2
048900* * * IC2274.2
049000* ************************************************* IC2274.2
049100* IC2274.2
049200 MOVE 1 TO REC-CT. IC2274.2
049300 MOVE "EXTERNAL FILE WRITE" TO FEATURE. IC2274.2
049400 MOVE "X-23 4.5.1" TO ANSI-REFERENCE. IC2274.2
049500 MOVE "EXT-FILE-TEST-02" TO PAR-NAME. IC2274.2
049600 MOVE "******************" TO EXTERNAL-FILE-RECORD. IC2274.2
049700 MOVE "**" TO F-S-PARAM. IC2274.2
049800 MOVE "AA" TO WRK-DATA-1 IC2274.2
049900 MOVE "PQRSTU" TO WRK-DATA-2 IC2274.2
050000 MOVE 123456 TO WRK-DATA-3 IC2274.2
050100 MOVE 9876 TO WRK-DATA-4. IC2274.2
050200 MOVE "<>" TO EXTERNAL-FILE-FS. IC2274.2
050300 GO TO EXT-FILE-TEST-02. IC2274.2
050400 EXT-FILE-DELETE-02. IC2274.2
050500 PERFORM DE-LETE. IC2274.2
050600 MOVE EXTERNAL-RECORD-WORK TO EXTERNAL-FILE-RECORD. IC2274.2
050700 WRITE EXTERNAL-FILE-RECORD. IC2274.2
050800 GO TO EXT-FILE-DELETE-02-02. IC2274.2
050900* IC2274.2
051000* ************************************************* IC2274.2
051100* * * IC2274.2
051200* * CHECK THAT SUBPROGRAM WILL WRITE * IC2274.2
051300* * * IC2274.2
051400* ************************************************* IC2274.2
051500* IC2274.2
051600 EXT-FILE-TEST-02. IC2274.2
051700 MOVE 2 TO ACTION-CODE. IC2274.2
051800 CALL "IC227A-1" USING CONTENT ACTION-CODE IC2274.2
051900 REFERENCE EXTERNAL-RECORD-WORK IC2274.2
052000 F-S-PARAM. IC2274.2
052100 IF F-S-PARAM IS EQUAL "00" IC2274.2
052200 PERFORM PASS IC2274.2
052300 ELSE IC2274.2
052400 MOVE "UNEXPECTED FILE STATUS VALUE RETURNED" IC2274.2
052500 TO RE-MARK IC2274.2
052600 MOVE F-S-PARAM TO COMPUTED-A IC2274.2
052700 MOVE "00" TO CORRECT-A IC2274.2
052800 PERFORM FAIL IC2274.2
052900 END-IF. IC2274.2
053000 GO TO EXT-FILE-TEST-02-02. IC2274.2
053100 EXT-FILE-DELETE-02-02. IC2274.2
053200 ADD 1 TO REC-CT IC2274.2
053300 PERFORM DE-LETE. IC2274.2
053400 GO TO EXT-FILE-TEST-02-END. IC2274.2
053500 EXT-FILE-TEST-02-02. IC2274.2
053600 ADD 1 TO REC-CT. IC2274.2
053700 IF EXTERNAL-FILE-FS IS EQUAL TO "<>" IC2274.2
053800 PERFORM PASS IC2274.2
053900 ELSE IC2274.2
054000 MOVE "MAIN PROGRAM FILE STATUS UPDATED" TO RE-MARK IC2274.2
054100 MOVE "<>" TO CORRECT-A IC2274.2
054200 MOVE EXTERNAL-FILE-FS TO COMPUTED-A IC2274.2
054300 PERFORM FAIL. IC2274.2
054400* IC2274.2
054500 EXT-FILE-TEST-02-END. IC2274.2
054600* IC2274.2
054700* IC2274.2
054800 EXT-INIT-03. IC2274.2
054900* IC2274.2
055000* ************************************************* IC2274.2
055100* * * IC2274.2
055200* * WRITE A RECORD FROM THE MAIN PROGRAM * IC2274.2
055300* * * IC2274.2
055400* ************************************************* IC2274.2
055500* IC2274.2
055600 MOVE 1 TO REC-CT. IC2274.2
055700 MOVE "EXTERNAL FILE WRITE" TO FEATURE. IC2274.2
055800 MOVE "X-23 4.5.1" TO ANSI-REFERENCE. IC2274.2
055900 MOVE "EXT-FILE-TEST-03" TO PAR-NAME. IC2274.2
056000 MOVE "BB" TO EXT-DATA-1 IC2274.2
056100 MOVE "ZYXWVU" TO EXT-DATA-2 IC2274.2
056200 MOVE 222222 TO EXT-DATA-3 IC2274.2
056300 MOVE 9765 TO EXT-DATA-4. IC2274.2
056400 MOVE "<>" TO EXTERNAL-FILE-FS. IC2274.2
056500 GO TO EXT-FILE-TEST-03-01. IC2274.2
056600 EXT-FILE-DELETE-03. IC2274.2
056700 PERFORM DE-LETE. IC2274.2
056800 GO TO EXT-FILE-TEST-03-END. IC2274.2
056900* IC2274.2
057000 EXT-FILE-TEST-03-01. IC2274.2
057100 WRITE EXTERNAL-FILE-RECORD. IC2274.2
057200 IF EXTERNAL-FILE-FS IS EQUAL TO "00" IC2274.2
057300 PERFORM PASS IC2274.2
057400 ELSE IC2274.2
057500 MOVE "MAIN PROGRAM FILE STATUS NON-ZERO" TO RE-MARK IC2274.2
057600 MOVE "00" TO CORRECT-A IC2274.2
057700 MOVE EXTERNAL-FILE-FS TO COMPUTED-A IC2274.2
057800 PERFORM FAIL. IC2274.2
057900* IC2274.2
058000 EXT-FILE-TEST-03-END. IC2274.2
058100* IC2274.2
058200* IC2274.2
058300 EXT-INIT-04. IC2274.2
058400* IC2274.2
058500* ************************************************* IC2274.2
058600* * * IC2274.2
058700* * CLOSE THE FILE THROUGH THE SUBPROGRAM * IC2274.2
058800* * * IC2274.2
058900* ************************************************* IC2274.2
059000* IC2274.2
059100 MOVE 1 TO REC-CT. IC2274.2
059200 MOVE "EXTERNAL FILE CLOSE" TO FEATURE. IC2274.2
059300 MOVE "X-23 4.5.1" TO ANSI-REFERENCE. IC2274.2
059400 MOVE "EXT-FILE-TEST-04" TO PAR-NAME. IC2274.2
059500 MOVE "**" TO F-S-PARAM. IC2274.2
059600 MOVE "<>" TO EXTERNAL-FILE-FS. IC2274.2
059700 GO TO EXT-FILE-TEST-04-01. IC2274.2
059800 EXT-FILE-DELETE-04-01. IC2274.2
059900 PERFORM DE-LETE. IC2274.2
060000 CLOSE EXTERNAL-FILE. IC2274.2
060100 GO TO EXT-FILE-DELETE-04-02. IC2274.2
060200* IC2274.2
060300 EXT-FILE-TEST-04-01. IC2274.2
060400 MOVE 3 TO ACTION-CODE. IC2274.2
060500 CALL "IC227A-1" USING CONTENT ACTION-CODE IC2274.2
060600 EXTERNAL-RECORD-WORK IC2274.2
060700 REFERENCE F-S-PARAM. IC2274.2
060800 IF F-S-PARAM IS EQUAL "00" IC2274.2
060900 PERFORM PASS IC2274.2
061000 ELSE IC2274.2
061100 MOVE "UNEXPECTED FILE STATUS VALUE RETURNED" IC2274.2
061200 TO RE-MARK IC2274.2
061300 MOVE F-S-PARAM TO COMPUTED-A IC2274.2
061400 MOVE "00" TO CORRECT-A IC2274.2
061500 PERFORM FAIL IC2274.2
061600 END-IF. IC2274.2
061700 GO TO EXT-FILE-TEST-04-02. IC2274.2
061800 EXT-FILE-DELETE-04-02. IC2274.2
061900 ADD 1 TO REC-CT IC2274.2
062000 PERFORM DE-LETE. IC2274.2
062100 GO TO EXT-FILE-TEST-04-END. IC2274.2
062200 EXT-FILE-TEST-04-02. IC2274.2
062300 ADD 1 TO REC-CT. IC2274.2
062400 IF EXTERNAL-FILE-FS IS EQUAL TO "<>" IC2274.2
062500 PERFORM PASS IC2274.2
062600 ELSE IC2274.2
062700 MOVE "MAIN PROGRAM FILE STATUS UPDATED" TO RE-MARK IC2274.2
062800 MOVE "<>" TO CORRECT-A IC2274.2
062900 MOVE EXTERNAL-FILE-FS TO COMPUTED-A IC2274.2
063000 PERFORM FAIL. IC2274.2
063100* IC2274.2
063200 EXT-FILE-TEST-04-END. IC2274.2
063300* IC2274.2
063400* IC2274.2
063500 EXT-INIT-05. IC2274.2
063600* IC2274.2
063700* ************************************************* IC2274.2
063800* * * IC2274.2
063900* * OPEN FILE FOR INPUT FROM SUBPROGRAM * IC2274.2
064000* * * IC2274.2
064100* ************************************************* IC2274.2
064200* IC2274.2
064300 MOVE 1 TO REC-CT. IC2274.2
064400 MOVE "EXTERNAL FILE OPEN" TO FEATURE. IC2274.2
064500 MOVE "X-23 4.5.1" TO ANSI-REFERENCE. IC2274.2
064600 MOVE "EXT-FILE-TEST-05" TO PAR-NAME. IC2274.2
064700 MOVE "******************" TO EXTERNAL-RECORD-WORK. IC2274.2
064800 MOVE EXTERNAL-RECORD-WORK TO EXTERNAL-RECORD-HOLD. IC2274.2
064900 MOVE "**" TO F-S-PARAM. IC2274.2
065000 MOVE "<>" TO EXTERNAL-FILE-FS. IC2274.2
065100 GO TO EXT-FILE-TEST-05-01. IC2274.2
065200 EXT-FILE-DELETE-05. IC2274.2
065300 PERFORM DE-LETE. IC2274.2
065400 OPEN INPUT EXTERNAL-FILE. IC2274.2
065500 GO TO EXT-FILE-DELETE-05-02. IC2274.2
065600 EXT-FILE-TEST-05-01. IC2274.2
065700 MOVE 4 TO ACTION-CODE. IC2274.2
065800 CALL ID1 USING BY CONTENT ACTION-CODE IC2274.2
065900 REFERENCE EXTERNAL-RECORD-WORK IC2274.2
066000 BY REFERENCE F-S-PARAM. IC2274.2
066100 IF F-S-PARAM IS EQUAL "00" IC2274.2
066200 PERFORM PASS IC2274.2
066300 ELSE IC2274.2
066400 MOVE "UNEXPECTED FILE STATUS VALUE RETURNED" IC2274.2
066500 TO RE-MARK IC2274.2
066600 MOVE F-S-PARAM TO COMPUTED-A IC2274.2
066700 MOVE "00" TO CORRECT-A IC2274.2
066800 PERFORM FAIL IC2274.2
066900 END-IF. IC2274.2
067000 GO TO EXT-FILE-TEST-05-02. IC2274.2
067100 EXT-FILE-DELETE-05-02. IC2274.2
067200 ADD 1 TO REC-CT IC2274.2
067300 PERFORM DE-LETE. IC2274.2
067400 GO TO EXT-FILE-DELETE-05-03. IC2274.2
067500 EXT-FILE-TEST-05-02. IC2274.2
067600 ADD 1 TO REC-CT. IC2274.2
067700 IF EXTERNAL-FILE-FS IS EQUAL TO "<>" IC2274.2
067800 PERFORM PASS IC2274.2
067900 ELSE IC2274.2
068000 MOVE "MAIN PROGRAM FILE STATUS UPDATED" TO RE-MARK IC2274.2
068100 MOVE "<>" TO CORRECT-A IC2274.2
068200 MOVE EXTERNAL-FILE-FS TO COMPUTED-A IC2274.2
068300 PERFORM FAIL. IC2274.2
068400* GO TO EXT-FILE-TEST-05-03. IC2274.2
068500 EXT-FILE-DELETE-05-03. IC2274.2
068600 ADD 1 TO REC-CT. IC2274.2
068700 PERFORM DE-LETE. IC2274.2
068800 GO TO EXT-FILE-DELETE-05-04. IC2274.2
068900 EXT-FILE-TEST-05-03. IC2274.2
069000 ADD 1 TO REC-CT. IC2274.2
069100 IF EXTERNAL-FILE-RECORD = EXTERNAL-RECORD-HOLD IC2274.2
069200 PERFORM PASS IC2274.2
069300 ELSE IC2274.2
069400 MOVE "PARAMETER NOT RETURNED THROUGH RECORD AREA" IC2274.2
069500 TO RE-MARK IC2274.2
069600 MOVE EXTERNAL-FILE-RECORD TO COMPUTED-A IC2274.2
069700 MOVE EXTERNAL-RECORD-HOLD TO CORRECT-A IC2274.2
069800 PERFORM FAIL. IC2274.2
069900 GO TO EXT-FILE-TEST-05-04. IC2274.2
070000 EXT-FILE-DELETE-05-04. IC2274.2
070100 ADD 1 TO REC-CT. IC2274.2
070200 PERFORM DE-LETE. IC2274.2
070300 GO TO EXT-FILE-TEST-05-END. IC2274.2
070400 EXT-FILE-TEST-05-04. IC2274.2
070500 ADD 1 TO REC-CT. IC2274.2
070600 IF EXTERNAL-RECORD-WORK IS = "OPEN OPEN OPEN" IC2274.2
070700 PERFORM PASS IC2274.2
070800 ELSE IC2274.2
070900 MOVE "PARAMETER RETURN INCORRECT" TO RE-MARK IC2274.2
071000 MOVE "OPEN OPEN OPEN" TO CORRECT-A IC2274.2
071100 MOVE EXTERNAL-RECORD-WORK TO COMPUTED-A IC2274.2
071200 PERFORM FAIL. IC2274.2
071300* IC2274.2
071400 EXT-FILE-TEST-05-END. IC2274.2
071500* IC2274.2
071600* IC2274.2
071700 EXT-INIT-06. IC2274.2
071800* IC2274.2
071900* ************************************************* IC2274.2
072000* * * IC2274.2
072100* * READ THE FIRST RECORD FROM THE FILE WITH * IC2274.2
072200* * THE MAIN PROGRAM . * IC2274.2
072300* * * IC2274.2
072400* ************************************************* IC2274.2
072500* IC2274.2
072600 MOVE 1 TO REC-CT. IC2274.2
072700 MOVE "EXTERNAL FILE READ" TO FEATURE. IC2274.2
072800 MOVE "X-23 4.5.1" TO ANSI-REFERENCE. IC2274.2
072900 MOVE "EXT-FILE-TEST-06" TO PAR-NAME. IC2274.2
073000 MOVE "%%%%%%%%%%%%%%%%%%" TO EXTERNAL-FILE-RECORD. IC2274.2
073100 MOVE "AAPQRSTU1234569876" TO EXTERNAL-RECORD-HOLD. IC2274.2
073200 MOVE "<>" TO EXTERNAL-FILE-FS. IC2274.2
073300 GO TO EXT-FILE-TEST-06-01. IC2274.2
073400 EXT-FILE-DELETE-06. IC2274.2
073500 PERFORM DE-LETE. IC2274.2
073600 GO TO EXT-FILE-DELETE-06-02. IC2274.2
073700 EXT-FILE-TEST-06-01. IC2274.2
073800 READ EXTERNAL-FILE NEXT RECORD IC2274.2
073900 AT END GO TO EXT-FILE-TEST-06-02. IC2274.2
074000 IF EXTERNAL-FILE-FS IS EQUAL "00" IC2274.2
074100 PERFORM PASS IC2274.2
074200 ELSE IC2274.2
074300 MOVE "UNEXPECTED FILE STATUS VALUE RETURNED" IC2274.2
074400 TO RE-MARK IC2274.2
074500 MOVE EXTERNAL-FILE-FS TO COMPUTED-A IC2274.2
074600 MOVE "00" TO CORRECT-A IC2274.2
074700 PERFORM FAIL IC2274.2
074800 END-IF. IC2274.2
074900 GO TO EXT-FILE-TEST-06-02. IC2274.2
075000 EXT-FILE-DELETE-06-02. IC2274.2
075100 ADD 1 TO REC-CT IC2274.2
075200 PERFORM DE-LETE. IC2274.2
075300 GO TO EXT-FILE-TEST-06-END. IC2274.2
075400 EXT-FILE-TEST-06-02. IC2274.2
075500 ADD 1 TO REC-CT. IC2274.2
075600 IF EXTERNAL-FILE-RECORD = EXTERNAL-RECORD-HOLD IC2274.2
075700 PERFORM PASS IC2274.2
075800 ELSE IC2274.2
075900 MOVE "EXPECTED RECORD NOT READ FROM FILE" IC2274.2
076000 TO RE-MARK IC2274.2
076100 MOVE EXTERNAL-FILE-RECORD TO COMPUTED-A IC2274.2
076200 MOVE EXTERNAL-RECORD-HOLD TO CORRECT-A IC2274.2
076300 PERFORM FAIL. IC2274.2
076400* IC2274.2
076500 EXT-FILE-TEST-06-END. IC2274.2
076600* IC2274.2
076700* IC2274.2
076800 EXT-INIT-07. IC2274.2
076900* IC2274.2
077000* ************************************************* IC2274.2
077100* * * IC2274.2
077200* * READ SECOND RECORD FROM THE FILE THROUGH * IC2274.2
077300* * THE SUBPROGRAM * IC2274.2
077400* * * IC2274.2
077500* ************************************************* IC2274.2
077600* IC2274.2
077700 MOVE 1 TO REC-CT. IC2274.2
077800 MOVE "EXTERNAL FILE READ" TO FEATURE. IC2274.2
077900 MOVE "X-23 4.5.1" TO ANSI-REFERENCE. IC2274.2
078000 MOVE "EXT-FILE-TEST-07" TO PAR-NAME. IC2274.2
078100 MOVE "%%%%%%%%%%%%%%%%%%" TO EXTERNAL-FILE-RECORD. IC2274.2
078200 MOVE ";;;;;;;;;;;;;;;;;;" TO EXTERNAL-RECORD-WORK. IC2274.2
078300 MOVE "BBZYXWVU2222229765" TO EXTERNAL-RECORD-HOLD. IC2274.2
078400 MOVE "**" TO F-S-PARAM. IC2274.2
078500 MOVE "<>" TO EXTERNAL-FILE-FS. IC2274.2
078600 GO TO EXT-FILE-TEST-07-01. IC2274.2
078700 EXT-FILE-DELETE-07. IC2274.2
078800 PERFORM DE-LETE. IC2274.2
078900 GO TO EXT-FILE-DELETE-07-02. IC2274.2
079000 EXT-FILE-TEST-07-01. IC2274.2
079100 MOVE 5 TO ACTION-CODE. IC2274.2
079200 CALL ID1 USING BY CONTENT ACTION-CODE IC2274.2
079300 REFERENCE EXTERNAL-RECORD-WORK IC2274.2
079400 BY REFERENCE F-S-PARAM. IC2274.2
079500 IF F-S-PARAM IS EQUAL "00" IC2274.2
079600 PERFORM PASS IC2274.2
079700 ELSE IC2274.2
079800 MOVE "UNEXPECTED FILE STATUS VALUE RETURNED" IC2274.2
079900 TO RE-MARK IC2274.2
080000 MOVE F-S-PARAM TO COMPUTED-A IC2274.2
080100 MOVE "00" TO CORRECT-A IC2274.2
080200 PERFORM FAIL IC2274.2
080300 END-IF. IC2274.2
080400 GO TO EXT-FILE-TEST-07-02. IC2274.2
080500 EXT-FILE-DELETE-07-02. IC2274.2
080600 ADD 1 TO REC-CT IC2274.2
080700 PERFORM DE-LETE. IC2274.2
080800 GO TO EXT-FILE-DELETE-07-03. IC2274.2
080900 EXT-FILE-TEST-07-02. IC2274.2
--> --------------------
--> maximum size reached
--> --------------------
¤ Dauer der Verarbeitung: 1.54 Sekunden
(vorverarbeitet)
¤
|
Haftungshinweis
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.
|
