| products/sources/formale sprachen/Cobol/Test-Suite/COBOL/DB/ |
|
Quellcode-Bibliothek© Kompilation durch diese Firma[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]Datei: replace.v Sprache: Unknown |
|
||||||
|
000100 IDENTIFICATION DIVISION. DB2034.2
000200 PROGRAM-ID. DB2034.2 000300 DB203A. DB2034.2 000400 AUTHOR. DB2034.2 000500 FEDERAL COMPILER TESTING CENTER. DB2034.2 000600 INSTALLATION. DB2034.2 000700 GENERAL SERVICES ADMINISTRATION DB2034.2 000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. DB2034.2 000900 SOFTWARE DEVELOPMENT OFFICE. DB2034.2 001000 5203 LEESBURG PIKE SUITE 1100 DB2034.2 001100 FALLS CHURCH VIRGINIA 22041. DB2034.2 001200 DB2034.2 001300 PHONE (703) 756-6153 DB2034.2 001400 DB2034.2 001500 " HIGH ". DB2034.2 001600 DATE-WRITTEN. DB2034.2 001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. DB2034.2 001800 CREATION DATE / VALIDATION DATE DB2034.2 001900 "4.2 ". DB2034.2 002000 SECURITY. DB2034.2 002100 NONE. DB2034.2 002200* DB2034.2 002300* * * * * * * * * * * * * * * * * * * * * *DB2034.2 002400* DB2034.2 002500* PROGRAM ABSTRACT DB2034.2 002600* DB2034.2 002700* DB203A TESTS THE CAPABILITY OF THE DEBUG MODULE TO HANDLE DB2034.2 002800* DEBUGGING PROCEDURES WHICH ARE MONITORING I-O FUNCTIONS DB2034.2 002900* OF THE RELATIVE I-O OR INDEXED I-O MODULES. THIS PROGRAM DB2034.2 003000* IS TO BE COMPILED AND EXECUTED WITH BOTH COMPILE AND OBJECT DB2034.2 003100* TIME DEBUGGING SWITCHES ON. THE DEBUGGING PROCEDURES DB2034.2 003200* SHOULD BE INCLUDED IN COMPILATION AND GENERATE CODE. DB2034.2 003300* DURING EXECUTION, A FILE IS ASSIGNED IN DYNAMIC MODE, DB2034.2 003400* CREATED SEQUENTIALLY, AND ACCESSED BOTH SEQUENTIALLY DB2034.2 003500* AND RANDOMLY. ITS RECORDS ARE 80 CHARACTERS IN LENGTH. DB2034.2 003600* EXECUTION OF "OPEN", "READ", "WRITE", "REWRITE", "START", DB2034.2 003700* AND "DELETE" FUNCTIONS SHOULD TRIGGER THE APPROPRIATE DB2034.2 003800* DEBUGGING PROCEDURES. DB2034.2 003900* DB2034.2 004000* DB2034.2 004100* DB2034.2 004200 ENVIRONMENT DIVISION. DB2034.2 004300 CONFIGURATION SECTION. DB2034.2 004400 SOURCE-COMPUTER. DB2034.2 004500 Card0130 DB2034.2 004600 WITH DEBUGGING MODE. DB2034.2 004700 OBJECT-COMPUTER. DB2034.2 004800 Card0131. DB2034.2 004900 SPECIAL-NAMES. DB2034.2 005000 C0086 DB2034.2 005100* XXXXX056 REPLACE WITH DISPLAY IMPLEMENTOR NAME DB2034.2 005200 IS THE-SYSTEM-PRINTER. DB2034.2 005300 INPUT-OUTPUT SECTION. DB2034.2 005400 FILE-CONTROL. DB2034.2 005500 SELECT PRINT-FILE ASSIGN TO DB2034.2 005600 "C0085" . DB2034.2 005700 SELECT IND-FILE ASSIGN TO DB2034.2 005800 "C0036" DB2034.2 005900 "C0068" DB2034.2 006000* XXXXX044 REPLACE WITH INDEX-FILE-NAME (*OPT J ONLY) DB2034.2 006100 ORGANIZATION IS INDEXED DB2034.2 006200 ACCESS MODE IS DYNAMIC DB2034.2 006300 RECORD KEY IS IND-KEY. DB2034.2 006400 DATA DIVISION. DB2034.2 006500 FILE SECTION. DB2034.2 006600 FD PRINT-FILE DB2034.2 006700 LABEL RECORDS DB2034.2 006800 Card0132 DB2034.2 006900 DATA RECORD IS PRINT-REC DUMMY-RECORD. DB2034.2 007000 01 PRINT-REC PICTURE X(120). DB2034.2 007100 01 DUMMY-RECORD PICTURE X(120). DB2034.2 007200 FD IND-FILE DB2034.2 007300 VALUE OF DB2034.2 007400 Impl1 DB2034.2 007500* XXXXX074 REPLACE WITH IMPLEMENTOR NAME (*OPT C ONLY) DB2034.2 007600 IS DB2034.2 007700 4711 DB2034.2 007800* XXXXX075 REPLACE WITH VALUE CLAUSE OBJECT (*OPT C ONLY) DB2034.2 007900 DB2034.2 008000* XXXXX069 REPLACE WITH ADDITIONAL INFO (*OPT G ONLY) DB2034.2 008100 LABEL RECORDS ARE STANDARD. DB2034.2 008200 01 IND-REC-1. DB2034.2 008300 02 FILLER PIC X(128). DB2034.2 008400 02 IND-KEY PIC XX. DB2034.2 008500 02 FILLER PIC X(110). DB2034.2 008600 01 IND-REC-2. DB2034.2 008700 02 IND-REC-1H PIC X(120). DB2034.2 008800 02 IND-REC-2H PIC X(120). DB2034.2 008900 WORKING-STORAGE SECTION. DB2034.2 009000 01 ITEM-1. DB2034.2 009100 02 KEY-1 PIC 99. DB2034.2 009200 02 LINE-1 PIC X(6). DB2034.2 009300 02 NAME-1 PIC X(30). DB2034.2 009400 02 UNQUAL-NAME-1 PIC X(30). DB2034.2 009500 02 CONTENTS-1. DB2034.2 009600 03 CONTENTS-1-1H PIC X(120). DB2034.2 009700 03 CONTENTS-1-2H PIC X(120). DB2034.2 009800 02 CONTENTS-REC. DB2034.2 009900 03 CONTENTS-REC-1H PIC X(120). DB2034.2 010000 03 CONTENTS-REC-2H PIC X(120). DB2034.2 010100 01 FILE-RECORD-INFORMATION-REC. DB2034.2 010200 03 FILE-RECORD-INFO-SKELETON. DB2034.2 010300 05 FILLER PICTURE X(48) VALUE DB2034.2 010400 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". DB2034.2 010500 05 FILLER PICTURE X(46) VALUE DB2034.2 010600 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". DB2034.2 010700 05 FILLER PICTURE X(26) VALUE DB2034.2 010800 ",LFIL=000000,ORG= ,LBLR= ". DB2034.2 010900 05 FILLER PICTURE X(37) VALUE DB2034.2 011000 ",RECKEY= ". DB2034.2 011100 05 FILLER PICTURE X(38) VALUE DB2034.2 011200 ",ALTKEY1= ". DB2034.2 011300 05 FILLER PICTURE X(38) VALUE DB2034.2 011400 ",ALTKEY2= ". DB2034.2 011500 05 FILLER PICTURE X(7) VALUE SPACE.DB2034.2 011600 03 FILE-RECORD-INFO OCCURS 10 TIMES. DB2034.2 011700 05 FILE-RECORD-INFO-P1-120. DB2034.2 011800 07 FILLER PIC X(5). DB2034.2 011900 07 XFILE-NAME PIC X(6). DB2034.2 012000 07 FILLER PIC X(8). DB2034.2 012100 07 XRECORD-NAME PIC X(6). DB2034.2 012200 07 FILLER PIC X(1). DB2034.2 012300 07 REELUNIT-NUMBER PIC 9(1). DB2034.2 012400 07 FILLER PIC X(7). DB2034.2 012500 07 XRECORD-NUMBER PIC 9(6). DB2034.2 012600 07 FILLER PIC X(6). DB2034.2 012700 07 UPDATE-NUMBER PIC 9(2). DB2034.2 012800 07 FILLER PIC X(5). DB2034.2 012900 07 ODO-NUMBER PIC 9(4). DB2034.2 013000 07 FILLER PIC X(5). DB2034.2 013100 07 XPROGRAM-NAME PIC X(5). DB2034.2 013200 07 FILLER PIC X(7). DB2034.2 013300 07 XRECORD-LENGTH PIC 9(6). DB2034.2 013400 07 FILLER PIC X(7). DB2034.2 013500 07 CHARS-OR-RECORDS PIC X(2). DB2034.2 013600 07 FILLER PIC X(1). DB2034.2 013700 07 XBLOCK-SIZE PIC 9(4). DB2034.2 013800 07 FILLER PIC X(6). DB2034.2 013900 07 RECORDS-IN-FILE PIC 9(6). DB2034.2 014000 07 FILLER PIC X(5). DB2034.2 014100 07 XFILE-ORGANIZATION PIC X(2). DB2034.2 014200 07 FILLER PIC X(6). DB2034.2 014300 07 XLABEL-TYPE PIC X(1). DB2034.2 014400 05 FILE-RECORD-INFO-P121-240. DB2034.2 014500 07 FILLER PIC X(8). DB2034.2 014600 07 XRECORD-KEY PIC X(29). DB2034.2 014700 07 FILLER PIC X(9). DB2034.2 014800 07 ALTERNATE-KEY1 PIC X(29). DB2034.2 014900 07 FILLER PIC X(9). DB2034.2 015000 07 ALTERNATE-KEY2 PIC X(29). DB2034.2 015100 07 FILLER PIC X(7). DB2034.2 015200 01 TEST-RESULTS. DB2034.2 015300 02 FILLER PICTURE X VALUE SPACE. DB2034.2 015400 02 FEATURE PICTURE X(20) VALUE SPACE. DB2034.2 015500 02 FILLER PICTURE X VALUE SPACE. DB2034.2 015600 02 P-OR-F PICTURE X(5) VALUE SPACE. DB2034.2 015700 02 FILLER PICTURE X VALUE SPACE. DB2034.2 015800 02 PAR-NAME. DB2034.2 015900 03 FILLER PICTURE X(12) VALUE SPACE. DB2034.2 016000 03 PARDOT-X PICTURE X VALUE SPACE. DB2034.2 016100 03 DOTVALUE PICTURE 99 VALUE ZERO. DB2034.2 016200 03 FILLER PIC X(5) VALUE SPACE. DB2034.2 016300 02 FILLER PIC X(10) VALUE SPACE. DB2034.2 016400 02 RE-MARK PIC X(61). DB2034.2 016500 01 TEST-COMPUTED. DB2034.2 016600 02 FILLER PIC X(30) VALUE SPACE. DB2034.2 016700 02 FILLER PIC X(17) VALUE " COMPUTED=". DB2034.2 016800 02 COMPUTED-X. DB2034.2 016900 03 COMPUTED-A PICTURE X(20) VALUE SPACE. DB2034.2 017000 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). DB2034.2 017100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). DB2034.2 017200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). DB2034.2 017300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). DB2034.2 017400 03 CM-18V0 REDEFINES COMPUTED-A. DB2034.2 017500 04 COMPUTED-18V0 PICTURE -9(18). DB2034.2 017600 04 FILLER PICTURE X. DB2034.2 017700 03 FILLER PIC X(50) VALUE SPACE. DB2034.2 017800 01 TEST-CORRECT. DB2034.2 017900 02 FILLER PIC X(30) VALUE SPACE. DB2034.2 018000 02 FILLER PIC X(17) VALUE " CORRECT =". DB2034.2 018100 02 CORRECT-X. DB2034.2 018200 03 CORRECT-A PICTURE X(20) VALUE SPACE. DB2034.2 018300 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). DB2034.2 018400 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). DB2034.2 018500 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). DB2034.2 018600 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). DB2034.2 018700 03 CR-18V0 REDEFINES CORRECT-A. DB2034.2 018800 04 CORRECT-18V0 PICTURE -9(18). DB2034.2 018900 04 FILLER PICTURE X. DB2034.2 019000 03 FILLER PIC X(50) VALUE SPACE. DB2034.2 019100 01 CCVS-C-1. DB2034.2 019200 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PADB2034.2 019300- "SS PARAGRAPH-NAME DB2034.2 019400- " REMARKS". DB2034.2 019500 02 FILLER PICTURE IS X(20) VALUE IS SPACE. DB2034.2 019600 01 CCVS-C-2. DB2034.2 019700 02 FILLER PICTURE IS X VALUE IS SPACE. DB2034.2 019800 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". DB2034.2 019900 02 FILLER PICTURE IS X(15) VALUE IS SPACE. DB2034.2 020000 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". DB2034.2 020100 02 FILLER PICTURE IS X(94) VALUE IS SPACE. DB2034.2 020200 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. DB2034.2 020300 01 REC-CT PICTURE 99 VALUE ZERO. DB2034.2 020400 01 DELETE-CNT PICTURE 999 VALUE ZERO. DB2034.2 020500 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. DB2034.2 020600 01 INSPECT-COUNTER PIC 999 VALUE ZERO. DB2034.2 020700 01 PASS-COUNTER PIC 999 VALUE ZERO. DB2034.2 020800 01 TOTAL-ERROR PIC 999 VALUE ZERO. DB2034.2 020900 01 ERROR-HOLD PIC 999 VALUE ZERO. DB2034.2 021000 01 DUMMY-HOLD PIC X(120) VALUE SPACE. DB2034.2 021100 01 RECORD-COUNT PIC 9(5) VALUE ZERO. DB2034.2 021200 01 CCVS-H-1. DB2034.2 021300 02 FILLER PICTURE X(27) VALUE SPACE. DB2034.2 021400 02 FILLER PICTURE X(67) VALUE DB2034.2 021500 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION DB2034.2 021600- " SYSTEM". DB2034.2 021700 02 FILLER PICTURE X(26) VALUE SPACE. DB2034.2 021800 01 CCVS-H-2. DB2034.2 021900 02 FILLER PICTURE X(52) VALUE IS DB2034.2 022000 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". DB2034.2 022100 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". DB2034.2 022200 02 TEST-ID PICTURE IS X(9). DB2034.2 022300 02 FILLER PICTURE IS X(40) VALUE IS SPACE. DB2034.2 022400 01 CCVS-H-3. DB2034.2 022500 02 FILLER PICTURE X(34) VALUE DB2034.2 022600 " FOR OFFICIAL USE ONLY ". DB2034.2 022700 02 FILLER PICTURE X(58) VALUE DB2034.2 022800 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".DB2034.2 022900 02 FILLER PICTURE X(28) VALUE DB2034.2 023000 " COPYRIGHT 1974 ". DB2034.2 023100 01 CCVS-E-1. DB2034.2 023200 02 FILLER PICTURE IS X(52) VALUE IS SPACE. DB2034.2 023300 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". DB2034.2 023400 02 ID-AGAIN PICTURE IS X(9). DB2034.2 023500 02 FILLER PICTURE X(45) VALUE IS DB2034.2 023600 " NTIS DISTRIBUTION COBOL 74". DB2034.2 023700 01 CCVS-E-2. DB2034.2 023800 02 FILLER PICTURE X(31) VALUE DB2034.2 023900 SPACE. DB2034.2 024000 02 FILLER PICTURE X(21) VALUE SPACE. DB2034.2 024100 02 CCVS-E-2-2. DB2034.2 024200 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. DB2034.2 024300 03 FILLER PICTURE IS X VALUE IS SPACE. DB2034.2 024400 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". DB2034.2 024500 01 CCVS-E-3. DB2034.2 024600 02 FILLER PICTURE X(22) VALUE DB2034.2 024700 " FOR OFFICIAL USE ONLY". DB2034.2 024800 02 FILLER PICTURE X(12) VALUE SPACE. DB2034.2 024900 02 FILLER PICTURE X(58) VALUE DB2034.2 025000 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".DB2034.2 025100 02 FILLER PICTURE X(13) VALUE SPACE. DB2034.2 025200 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". DB2034.2 025300 01 CCVS-E-4. DB2034.2 025400 02 CCVS-E-4-1 PIC XXX VALUE SPACE. DB2034.2 025500 02 FILLER PIC XXXX VALUE " OF ". DB2034.2 025600 02 CCVS-E-4-2 PIC XXX VALUE SPACE. DB2034.2 025700 02 FILLER PIC X(40) VALUE DB2034.2 025800 " TESTS WERE EXECUTED SUCCESSFULLY". DB2034.2 025900 01 XXINFO. DB2034.2 026000 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". DB2034.2 026100 02 INFO-TEXT. DB2034.2 026200 04 FILLER PIC X(20) VALUE SPACE. DB2034.2 026300 04 XXCOMPUTED PIC X(20). DB2034.2 026400 04 FILLER PIC X(5) VALUE SPACE. DB2034.2 026500 04 XXCORRECT PIC X(20). DB2034.2 026600 01 HYPHEN-LINE. DB2034.2 026700 02 FILLER PICTURE IS X VALUE IS SPACE. DB2034.2 026800 02 FILLER PICTURE IS X(65) VALUE IS "************************DB2034.2 026900- "*****************************************". DB2034.2 027000 02 FILLER PICTURE IS X(54) VALUE IS "************************DB2034.2 027100- "******************************". DB2034.2 027200 01 CCVS-PGM-ID PIC X(6) VALUE DB2034.2 027300 "DB203A". DB2034.2 027400 PROCEDURE DIVISION. DB2034.2 027500 DECLARATIVES. DB2034.2 027600 FILENAME-PROC SECTION. DB2034.2 027700 USE FOR DEBUGGING ON IND-FILE IND-REC-1. DB2034.2 027800 FILENAME-1. DB2034.2 027900 MOVE 1 TO KEY-1. DB2034.2 028000 MOVE DEBUG-LINE TO LINE-1. DB2034.2 028100 MOVE DEBUG-NAME TO NAME-1 UNQUAL-NAME-1. DB2034.2 028200 MOVE DEBUG-CONTENTS TO CONTENTS-1. DB2034.2 028300 INSPECT UNQUAL-NAME-1 REPLACING CHARACTERS DB2034.2 028400 BY SPACES AFTER INITIAL SPACE. DB2034.2 028500 END DECLARATIVES. DB2034.2 028600 CCVS1 SECTION. DB2034.2 028700 OPEN-FILES. DB2034.2 028800 OPEN OUTPUT PRINT-FILE. DB2034.2 028900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. DB2034.2 029000 MOVE SPACE TO TEST-RESULTS. DB2034.2 029100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. DB2034.2 029200 GO TO CCVS1-EXIT. DB2034.2 029300 CLOSE-FILES. DB2034.2 029400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. DB2034.2 029500 TERMINATE-CCVS. DB2034.2 029600 EXIT PROGRAM. DB2034.2 029700 TERMINATE-CALL. DB2034.2 029800 STOP RUN. DB2034.2 029900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. DB2034.2 030000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. DB2034.2 030100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. DB2034.2 030200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. DB2034.2 030300 MOVE "****TEST DELETED****" TO RE-MARK. DB2034.2 030400 PRINT-DETAIL. DB2034.2 030500 IF REC-CT NOT EQUAL TO ZERO DB2034.2 030600 MOVE "." TO PARDOT-X DB2034.2 030700 MOVE REC-CT TO DOTVALUE. DB2034.2 030800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. DB2034.2 030900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE DB2034.2 031000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX DB2034.2 031100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. DB2034.2 031200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. DB2034.2 031300 MOVE SPACE TO CORRECT-X. DB2034.2 031400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. DB2034.2 031500 MOVE SPACE TO RE-MARK. DB2034.2 031600 HEAD-ROUTINE. DB2034.2 031700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2034.2 031800 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. DB2034.2 031900 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. DB2034.2 032000 COLUMN-NAMES-ROUTINE. DB2034.2 032100 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2034.2 032200 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2034.2 032300 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2034.2 032400 END-ROUTINE. DB2034.2 032500 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.DB2034.2 032600 END-RTN-EXIT. DB2034.2 032700 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2034.2 032800 END-ROUTINE-1. DB2034.2 032900 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO DB2034.2 033000 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. DB2034.2 033100 ADD PASS-COUNTER TO ERROR-HOLD. DB2034.2 033200* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. DB2034.2 033300 MOVE PASS-COUNTER TO CCVS-E-4-1. DB2034.2 033400 MOVE ERROR-HOLD TO CCVS-E-4-2. DB2034.2 033500 MOVE CCVS-E-4 TO CCVS-E-2-2. DB2034.2 033600 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. DB2034.2 033700 END-ROUTINE-12. DB2034.2 033800 MOVE "TEST(S) FAILED" TO ENDER-DESC. DB2034.2 033900 IF ERROR-COUNTER IS EQUAL TO ZERO DB2034.2 034000 MOVE "NO " TO ERROR-TOTAL DB2034.2 034100 ELSE DB2034.2 034200 MOVE ERROR-COUNTER TO ERROR-TOTAL. DB2034.2 034300 MOVE CCVS-E-2 TO DUMMY-RECORD. DB2034.2 034400 PERFORM WRITE-LINE. DB2034.2 034500 END-ROUTINE-13. DB2034.2 034600 IF DELETE-CNT IS EQUAL TO ZERO DB2034.2 034700 MOVE "NO " TO ERROR-TOTAL ELSE DB2034.2 034800 MOVE DELETE-CNT TO ERROR-TOTAL. DB2034.2 034900 MOVE "TEST(S) DELETED " TO ENDER-DESC. DB2034.2 035000 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2034.2 035100 IF INSPECT-COUNTER EQUAL TO ZERO DB2034.2 035200 MOVE "NO " TO ERROR-TOTAL DB2034.2 035300 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. DB2034.2 035400 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. DB2034.2 035500 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2034.2 035600 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2034.2 035700 WRITE-LINE. DB2034.2 035800 ADD 1 TO RECORD-COUNT. DB2034.2 035900 IF RECORD-COUNT GREATER 50 DB2034.2 036000 MOVE DUMMY-RECORD TO DUMMY-HOLD DB2034.2 036100 MOVE SPACE TO DUMMY-RECORD DB2034.2 036200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE DB2034.2 036300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN DB2034.2 036400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES DB2034.2 036500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN DB2034.2 036600 MOVE DUMMY-HOLD TO DUMMY-RECORD DB2034.2 036700 MOVE ZERO TO RECORD-COUNT. DB2034.2 036800 PERFORM WRT-LN. DB2034.2 036900 WRT-LN. DB2034.2 037000 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. DB2034.2 037100 MOVE SPACE TO DUMMY-RECORD. DB2034.2 037200 BLANK-LINE-PRINT. DB2034.2 037300 PERFORM WRT-LN. DB2034.2 037400 FAIL-ROUTINE. DB2034.2 037500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. DB2034.2 037600 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. DB2034.2 037700 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. DB2034.2 037800 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2034.2 037900 GO TO FAIL-ROUTINE-EX. DB2034.2 038000 FAIL-ROUTINE-WRITE. DB2034.2 038100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE DB2034.2 038200 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. DB2034.2 038300 FAIL-ROUTINE-EX. EXIT. DB2034.2 038400 BAIL-OUT. DB2034.2 038500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. DB2034.2 038600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. DB2034.2 038700 BAIL-OUT-WRITE. DB2034.2 038800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. DB2034.2 038900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2034.2 039000 BAIL-OUT-EX. EXIT. DB2034.2 039100 CCVS1-EXIT. DB2034.2 039200 EXIT. DB2034.2 039300 BEGIN-DB203A-TESTS SECTION. DB2034.2 039400 SET-UP-REC-AREA. DB2034.2 039500 MOVE FILE-RECORD-INFO-SKELETON TO FILE-RECORD-INFO (1). DB2034.2 039600 MOVE "IX-FD1" TO XFILE-NAME (1). DB2034.2 039700 MOVE "REC-1" TO XRECORD-NAME (1). DB2034.2 039800 MOVE ".XXX." TO XPROGRAM-NAME (1). DB2034.2 039900 MOVE 240 TO XRECORD-LENGTH (1). DB2034.2 040000 MOVE "RC" TO CHARS-OR-RECORDS (1). DB2034.2 040100 MOVE 1 TO XBLOCK-SIZE (1). DB2034.2 040200 MOVE 5 TO RECORDS-IN-FILE (1). DB2034.2 040300 MOVE "IX" TO XFILE-ORGANIZATION (1). DB2034.2 040400 MOVE "S" TO XLABEL-TYPE (1). DB2034.2 040500 OPEN-TEST-1-INIT. DB2034.2 040600 MOVE 0 TO KEY-1. DB2034.2 040700 MOVE "OPEN-TEST-1" TO PAR-NAME. DB2034.2 040800 MOVE "DEBUG OPEN OUTPUT" TO FEATURE. DB2034.2 040900 OPEN-TEST-1. DB2034.2 041000 OPEN OUTPUT IND-FILE. DB2034.2 041100 IF KEY-1 IS EQUAL TO 1 DB2034.2 041200 PERFORM PASS DB2034.2 041300 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2034.2 041400 ELSE PERFORM FAIL DB2034.2 041500 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK. DB2034.2 041600 PERFORM GEN-WRITE. DB2034.2 041700 GO TO WRITE-TEST-1-INIT. DB2034.2 041800 OPEN-TEST-1-DELETE. DB2034.2 041900 PERFORM DE-LETE. DB2034.2 042000 PERFORM GEN-WRITE. DB2034.2 042100 WRITE-TEST-1-INIT. DB2034.2 042200 MOVE 0 TO KEY-1. DB2034.2 042300 MOVE "WRITE-TEST-1" TO PAR-NAME. DB2034.2 042400 MOVE "DEBUG WRITE RECORD" TO FEATURE. DB2034.2 042500 WRITE-TEST-1. DB2034.2 042600 MOVE 1 TO XRECORD-NUMBER (1). DB2034.2 042700 MOVE FILE-RECORD-INFO (1) TO IND-REC-2. DB2034.2 042800 MOVE "02" TO IND-KEY. DB2034.2 042900 WRITE IND-REC-2 INVALID KEY GO TO ABORT-PGM. DB2034.2 043000 MOVE 2 TO XRECORD-NUMBER (1). DB2034.2 043100 MOVE FILE-RECORD-INFO (1) TO IND-REC-2. DB2034.2 043200 MOVE "04" TO IND-KEY. DB2034.2 043300 WRITE IND-REC-2 INVALID KEY GO TO ABORT-PGM. DB2034.2 043400 MOVE 3 TO XRECORD-NUMBER (1). DB2034.2 043500 MOVE FILE-RECORD-INFO (1) TO IND-REC-2. DB2034.2 043600 MOVE "06" TO IND-KEY. DB2034.2 043700 WRITE IND-REC-2 INVALID KEY GO TO ABORT-PGM. DB2034.2 043800 MOVE 4 TO XRECORD-NUMBER (1). DB2034.2 043900 MOVE FILE-RECORD-INFO (1) TO IND-REC-2. DB2034.2 044000 MOVE "08" TO IND-KEY. DB2034.2 044100 WRITE IND-REC-2 INVALID KEY GO TO ABORT-PGM. DB2034.2 044200 MOVE 5 TO XRECORD-NUMBER (1). DB2034.2 044300 MOVE FILE-RECORD-INFO (1) TO IND-REC-2. DB2034.2 044400 MOVE "10" TO IND-KEY. DB2034.2 044500 WRITE IND-REC-1 INVALID KEY GO TO ABORT-PGM. DB2034.2 044600 IF KEY-1 IS EQUAL TO 1 DB2034.2 044700 PERFORM PASS DB2034.2 044800 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2034.2 044900 ELSE PERFORM FAIL DB2034.2 045000 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK. DB2034.2 045100 PERFORM GEN-WRITE. DB2034.2 045200 GO TO CLOSE-TEST-1-INIT. DB2034.2 045300 WRITE-TEST-1-DELETE. DB2034.2 045400 PERFORM DE-LETE. DB2034.2 045500 PERFORM GEN-WRITE. DB2034.2 045600 CLOSE-TEST-1-INIT. DB2034.2 045700 MOVE 0 TO KEY-1. DB2034.2 045800 MOVE "CLOSE-TEST-1" TO PAR-NAME. DB2034.2 045900 MOVE "DEBUG CLOSE FILE" TO FEATURE. DB2034.2 046000 CLOSE-TEST-1. DB2034.2 046100 CLOSE IND-FILE. DB2034.2 046200 IF KEY-1 IS EQUAL TO 1 DB2034.2 046300 PERFORM PASS DB2034.2 046400 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2034.2 046500 ELSE PERFORM FAIL DB2034.2 046600 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK. DB2034.2 046700 PERFORM GEN-WRITE. DB2034.2 046800 GO TO OPEN-TEST-2-INIT. DB2034.2 046900 CLOSE-TEST-1-DELETE. DB2034.2 047000 PERFORM DE-LETE. DB2034.2 047100 PERFORM GEN-WRITE. DB2034.2 047200 OPEN-TEST-2-INIT. DB2034.2 047300 MOVE 0 TO KEY-1. DB2034.2 047400 MOVE "OPEN-TEST-2" TO PAR-NAME. DB2034.2 047500 MOVE "DEBUG OPEN I-O" TO FEATURE. DB2034.2 047600 OPEN-TEST-2. DB2034.2 047700 OPEN I-O IND-FILE. DB2034.2 047800 IF KEY-1 IS EQUAL TO 1 DB2034.2 047900 PERFORM PASS DB2034.2 048000 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2034.2 048100 ELSE PERFORM FAIL DB2034.2 048200 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK. DB2034.2 048300 PERFORM GEN-WRITE. DB2034.2 048400 GO TO READ-TEST-1-INIT. DB2034.2 048500 OPEN-TEST-2-DELETE. DB2034.2 048600 PERFORM DE-LETE. DB2034.2 048700 PERFORM GEN-WRITE. DB2034.2 048800 READ-TEST-1-INIT. DB2034.2 048900 MOVE SPACES TO ITEM-1. DB2034.2 049000 MOVE 0 TO KEY-1. DB2034.2 049100 MOVE "READ-TEST-1" TO PAR-NAME. DB2034.2 049200 MOVE "DEBUG READ RANDOM" TO FEATURE. DB2034.2 049300 READ-TEST-1. DB2034.2 049400 MOVE "04" TO IND-KEY. DB2034.2 049500******************************************************************DB2034.2 049600* THE DEBUG-LINE (INSPT) TEST NAMED IN THE OUTPUT REPORT AS *DB2034.2 049700* "READ-TEST-1A" SHOULD POINT TO THE EXECUTABLE STATEMENT *DB2034.2 049800* WHICH FOLLOWS THIS COMMENT SET AND WHICH READS, "READ *DB2034.2 049900* IND-FILE KEY IS IND-KEY INVALID KEY GO TO ABORT-PGM.". *DB2034.2 050000******************************************************************DB2034.2 050100 READ IND-FILE KEY IS IND-KEY DB2034.2 050200 INVALID KEY GO TO ABORT-PGM. DB2034.2 050300 IF KEY-1 IS EQUAL TO 1 DB2034.2 050400 PERFORM PASS DB2034.2 050500 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2034.2 050600 PERFORM GEN-WRITE DB2034.2 050700 GO TO READ-TEST-1A DB2034.2 050800 ELSE PERFORM FAIL DB2034.2 050900 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2034.2 051000 PERFORM GEN-WRITE DB2034.2 051100 PERFORM DELETE-READ-TEST-1-SUBTESTS DB2034.2 051200 GO TO REWRITE-TEST-1-INIT. DB2034.2 051300 READ-TEST-1-DELETE. DB2034.2 051400 PERFORM DE-LETE. DB2034.2 051500 PERFORM GEN-WRITE. DB2034.2 051600 PERFORM DELETE-READ-TEST-1-SUBTESTS. DB2034.2 051700 GO TO READ-TEST-2-INIT. DB2034.2 051800 DELETE-READ-TEST-1-SUBTESTS. DB2034.2 051900 MOVE "READ-TEST-1A" TO PAR-NAME. DB2034.2 052000 PERFORM DE-LETE. DB2034.2 052100 PERFORM GEN-WRITE. DB2034.2 052200 MOVE "READ-TEST-1B" TO PAR-NAME. DB2034.2 052300 PERFORM DE-LETE. DB2034.2 052400 PERFORM GEN-WRITE. DB2034.2 052500 MOVE "READ-TEST-1C" TO PAR-NAME. DB2034.2 052600 PERFORM DE-LETE. DB2034.2 052700 PERFORM GEN-WRITE. DB2034.2 052800 READ-TEST-1A. DB2034.2 052900 MOVE "READ-TEST-1A" TO PAR-NAME. DB2034.2 053000 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB2034.2 053100 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB2034.2 053200 MOVE LINE-1 TO COMPUTED-A. DB2034.2 053300 PERFORM INSPT. DB2034.2 053400 PERFORM GEN-WRITE. DB2034.2 053500 READ-TEST-1B. DB2034.2 053600 MOVE "READ-TEST-1B" TO PAR-NAME. DB2034.2 053700 IF UNQUAL-NAME-1 IS EQUAL TO "IND-FILE" DB2034.2 053800 PERFORM PASS DB2034.2 053900 ELSE PERFORM FAIL DB2034.2 054000 MOVE "IND-FILE" TO CORRECT-A DB2034.2 054100 MOVE NAME-1 TO COMPUTED-A. DB2034.2 054200 MOVE "DEBUG-NAME" TO RE-MARK. DB2034.2 054300 PERFORM GEN-WRITE. DB2034.2 054400 READ-TEST-1C. DB2034.2 054500 MOVE "READ-TEST-1C" TO PAR-NAME. DB2034.2 054600 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2034.2 054700 IF CONTENTS-1 IS EQUAL TO IND-REC-2 DB2034.2 054800 PERFORM PASS DB2034.2 054900 PERFORM GEN-WRITE DB2034.2 055000 GO TO READ-TEST-2-INIT DB2034.2 055100 ELSE PERFORM FAIL DB2034.2 055200 MOVE "LINES 1 AND 3 BELOW" TO COMPUTED-A DB2034.2 055300 MOVE "LINES 2 AND 4 BELOW" TO CORRECT-A. DB2034.2 055400 PERFORM GEN-WRITE. DB2034.2 055500 MOVE CONTENTS-1-1H TO PRINT-REC. DB2034.2 055600 PERFORM WRITE-LINE. DB2034.2 055700 MOVE IND-REC-1H TO PRINT-REC. DB2034.2 055800 PERFORM WRITE-LINE. DB2034.2 055900 MOVE CONTENTS-1-2H TO PRINT-REC. DB2034.2 056000 PERFORM WRITE-LINE. DB2034.2 056100 MOVE IND-REC-2H TO PRINT-REC. DB2034.2 056200 PERFORM WRITE-LINE. DB2034.2 056300 READ-TEST-2-INIT. DB2034.2 056400 MOVE SPACES TO ITEM-1. DB2034.2 056500 MOVE 0 TO KEY-1. DB2034.2 056600 MOVE "READ-TEST-2" TO PAR-NAME. DB2034.2 056700 MOVE "DEBUG READ INV KEY" TO FEATURE. DB2034.2 056800 READ-TEST-2. DB2034.2 056900 MOVE "05" TO IND-KEY. DB2034.2 057000 READ IND-FILE KEY IS IND-KEY DB2034.2 057100 INVALID KEY GO TO READ-TEST-2-CONT. DB2034.2 057200 READ-TEST-2-DELETE. DB2034.2 057300 PERFORM DE-LETE. DB2034.2 057400 PERFORM GEN-WRITE. DB2034.2 057500 GO TO REWRITE-TEST-1-INIT. DB2034.2 057600 READ-TEST-2-CONT. DB2034.2 057700 IF KEY-1 IS EQUAL TO 0 DB2034.2 057800 PERFORM PASS DB2034.2 057900 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2034.2 058000 ELSE PERFORM FAIL DB2034.2 058100 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK. DB2034.2 058200 PERFORM GEN-WRITE. DB2034.2 058300 REWRITE-TEST-1-INIT. DB2034.2 058400 MOVE SPACES TO ITEM-1. DB2034.2 058500 MOVE 0 TO KEY-1. DB2034.2 058600 MOVE "REWRITE-TEST-1" TO PAR-NAME. DB2034.2 058700 MOVE "DEBUG REWRITE RECORD" TO FEATURE. DB2034.2 058800 REWRITE-TEST-1. DB2034.2 058900 MOVE 2 TO XRECORD-NUMBER (1). DB2034.2 059000 MOVE 1 TO UPDATE-NUMBER (1). DB2034.2 059100 MOVE FILE-RECORD-INFO (1) TO IND-REC-2. DB2034.2 059200 MOVE "04" TO IND-KEY. DB2034.2 059300 MOVE IND-REC-2 TO CONTENTS-REC. DB2034.2 059400******************************************************************DB2034.2 059500* THE DEBUG-LINE (INSPT) TEST NAMED IN THE OUTPUT REPORT AS *DB2034.2 059600* "REWRITE-TEST-1A" SHOULD POINT TO THE EXECUTABLE STATEMENT *DB2034.2 059700* WHICH FOLLOWS THIS COMMENT SET AND WHICH READS, *DB2034.2 059800* "REWRITE IND-REC-1 INVALID KEY GO TO ABORT-PGM.". *DB2034.2 059900******************************************************************DB2034.2 060000 REWRITE IND-REC-1 INVALID KEY GO TO ABORT-PGM. DB2034.2 060100 IF KEY-1 IS EQUAL TO 1 DB2034.2 060200 PERFORM PASS DB2034.2 060300 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2034.2 060400 PERFORM GEN-WRITE DB2034.2 060500 GO TO REWRITE-TEST-1A DB2034.2 060600 ELSE PERFORM FAIL DB2034.2 060700 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2034.2 060800 PERFORM GEN-WRITE DB2034.2 060900 PERFORM DELETE-REWRITE-TEST-1-SUBTESTS DB2034.2 061000 GO TO REWRITE-TEST-2-INIT. DB2034.2 061100 REWRITE-TEST-1-DELETE. DB2034.2 061200 PERFORM DE-LETE. DB2034.2 061300 PERFORM GEN-WRITE. DB2034.2 061400 PERFORM DELETE-REWRITE-TEST-1-SUBTESTS. DB2034.2 061500 GO TO REWRITE-TEST-2-INIT. DB2034.2 061600 DELETE-REWRITE-TEST-1-SUBTESTS. DB2034.2 061700 MOVE "REWRITE-TEST-1A" TO PAR-NAME. DB2034.2 061800 PERFORM DE-LETE. DB2034.2 061900 PERFORM GEN-WRITE. DB2034.2 062000 MOVE "REWRITE-TEST-1B" TO PAR-NAME. DB2034.2 062100 PERFORM DE-LETE. DB2034.2 062200 PERFORM GEN-WRITE. DB2034.2 062300 MOVE "REWRITE-TEST-1C" TO PAR-NAME. DB2034.2 062400 PERFORM DE-LETE. DB2034.2 062500 PERFORM GEN-WRITE. DB2034.2 062600 REWRITE-TEST-1A. DB2034.2 062700 MOVE "REWRITE-TEST-1A" TO PAR-NAME. DB2034.2 062800 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB2034.2 062900 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB2034.2 063000 MOVE LINE-1 TO COMPUTED-A. DB2034.2 063100 PERFORM INSPT. DB2034.2 063200 PERFORM GEN-WRITE. DB2034.2 063300 REWRITE-TEST-1B. DB2034.2 063400 MOVE "REWRITE-TEST-1B" TO PAR-NAME. DB2034.2 063500 IF UNQUAL-NAME-1 IS EQUAL TO "IND-REC-1" DB2034.2 063600 PERFORM PASS DB2034.2 063700 ELSE PERFORM FAIL DB2034.2 063800 MOVE "IND-REC-1" TO CORRECT-A DB2034.2 063900 MOVE NAME-1 TO COMPUTED-A. DB2034.2 064000 MOVE "DEBUG-NAME" TO RE-MARK. DB2034.2 064100 PERFORM GEN-WRITE. DB2034.2 064200 REWRITE-TEST-1C. DB2034.2 064300 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2034.2 064400 MOVE "REWRITE-TEST-1C" TO PAR-NAME. DB2034.2 064500 IF CONTENTS-1 IS EQUAL TO CONTENTS-REC DB2034.2 064600 PERFORM PASS DB2034.2 064700 PERFORM GEN-WRITE DB2034.2 064800 GO TO REWRITE-TEST-2-INIT DB2034.2 064900 ELSE PERFORM FAIL DB2034.2 065000 MOVE "LINES 1 AND 3 BELOW" TO COMPUTED-A DB2034.2 065100 MOVE "LINES 2 AND 4 BELOW" TO CORRECT-A DB2034.2 065200 PERFORM GEN-WRITE. DB2034.2 065300 MOVE CONTENTS-1-1H TO PRINT-REC. DB2034.2 065400 PERFORM WRITE-LINE. DB2034.2 065500 MOVE CONTENTS-REC-1H TO PRINT-REC. DB2034.2 065600 PERFORM WRITE-LINE. DB2034.2 065700 MOVE CONTENTS-1-2H TO PRINT-REC. DB2034.2 065800 PERFORM WRITE-LINE. DB2034.2 065900 MOVE CONTENTS-REC-2H TO PRINT-REC. DB2034.2 066000 PERFORM WRITE-LINE. DB2034.2 066100 REWRITE-TEST-2-INIT. DB2034.2 066200 MOVE SPACES TO ITEM-1. DB2034.2 066300 MOVE 0 TO KEY-1. DB2034.2 066400 MOVE "REWRITE-TEST-2" TO PAR-NAME. DB2034.2 066500 MOVE "DEBUG REWRITE INVLID" TO FEATURE. DB2034.2 066600 REWRITE-TEST-2. DB2034.2 066700 MOVE 6 TO XRECORD-NUMBER (1). DB2034.2 066800 MOVE 1 TO UPDATE-NUMBER (1). DB2034.2 066900 MOVE FILE-RECORD-INFO (1) TO IND-REC-2. DB2034.2 067000 MOVE "03" TO IND-KEY. DB2034.2 067100 REWRITE IND-REC-1 INVALID KEY GO TO REWRITE-TEST-2-CONT. DB2034.2 067200 REWRITE-TEST-2-DELETE. DB2034.2 067300 PERFORM DE-LETE. DB2034.2 067400 PERFORM GEN-WRITE. DB2034.2 067500 GO TO START-TEST-1-INIT. DB2034.2 067600 REWRITE-TEST-2-CONT. DB2034.2 067700 IF KEY-1 IS EQUAL TO 1 DB2034.2 067800 PERFORM PASS DB2034.2 067900 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2034.2 068000 ELSE PERFORM FAIL DB2034.2 068100 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK. DB2034.2 068200 PERFORM GEN-WRITE. DB2034.2 068300 START-TEST-1-INIT. DB2034.2 068400 MOVE SPACES TO ITEM-1. DB2034.2 068500 MOVE 0 TO KEY-1. DB2034.2 068600 MOVE "START-TEST-1" TO PAR-NAME. DB2034.2 068700 MOVE "DEBUG START FILENAME" TO FEATURE. DB2034.2 068800 START-TEST-1. DB2034.2 068900 MOVE "05" TO IND-KEY. DB2034.2 069000 START IND-FILE KEY IS GREATER THAN IND-KEY DB2034.2 069100 INVALID KEY GO TO ABORT-PGM. DB2034.2 069200 IF KEY-1 IS EQUAL TO 1 DB2034.2 069300 PERFORM PASS DB2034.2 069400 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2034.2 069500 PERFORM GEN-WRITE DB2034.2 069600 GO TO START-TEST-1A DB2034.2 069700 ELSE PERFORM FAIL DB2034.2 069800 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2034.2 069900 PERFORM GEN-WRITE DB2034.2 070000 PERFORM DELETE-START-TEST-1-SUBTEST DB2034.2 070100 GO TO START-TEST-2-INIT. DB2034.2 070200 START-TEST-1-DELETE. DB2034.2 070300 PERFORM DE-LETE. DB2034.2 070400 PERFORM GEN-WRITE. DB2034.2 070500 PERFORM DELETE-START-TEST-1-SUBTEST. DB2034.2 070600 GO TO START-TEST-2-INIT. DB2034.2 070700 DELETE-START-TEST-1-SUBTEST. DB2034.2 070800 MOVE "START-TEST-1A" TO PAR-NAME. DB2034.2 070900 PERFORM DE-LETE. DB2034.2 071000 PERFORM GEN-WRITE. DB2034.2 071100 START-TEST-1A. DB2034.2 071200 MOVE "START-TEST-1A" TO PAR-NAME. DB2034.2 071300 IF CONTENTS-1 IS EQUAL TO SPACES DB2034.2 071400 PERFORM PASS DB2034.2 071500 ELSE PERFORM FAIL DB2034.2 071600 MOVE CONTENTS-1 TO COMPUTED-A DB2034.2 071700 MOVE "(SPACES)" TO CORRECT-A. DB2034.2 071800 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2034.2 071900 PERFORM GEN-WRITE. DB2034.2 072000 START-TEST-2-INIT. DB2034.2 072100 MOVE 0 TO KEY-1. DB2034.2 072200 MOVE "START-TEST-2" TO PAR-NAME. DB2034.2 072300 MOVE "DEBUG START INV KEY" TO FEATURE. DB2034.2 072400 START-TEST-2. DB2034.2 072500 MOVE "12" TO IND-KEY. DB2034.2 072600 START IND-FILE KEY IS GREATER THAN IND-KEY DB2034.2 072700 INVALID KEY GO TO START-TEST-2-CONT. DB2034.2 072800 START-TEST-2-DELETE. DB2034.2 072900 PERFORM DE-LETE. DB2034.2 073000 PERFORM GEN-WRITE. DB2034.2 073100 GO TO DELETE-TEST-1-INIT. DB2034.2 073200 START-TEST-2-CONT. DB2034.2 073300 IF KEY-1 IS EQUAL TO 1 DB2034.2 073400 PERFORM PASS DB2034.2 073500 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2034.2 073600 ELSE PERFORM FAIL DB2034.2 073700 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK. DB2034.2 073800 PERFORM GEN-WRITE. DB2034.2 073900 DELETE-TEST-1-INIT. DB2034.2 074000 MOVE SPACES TO ITEM-1. DB2034.2 074100 MOVE 0 TO KEY-1. DB2034.2 074200 MOVE "DELETE-TEST-1" TO PAR-NAME. DB2034.2 074300 MOVE "DEBUG DELETE FILE" TO FEATURE. DB2034.2 074400 DELETE-TEST-1. DB2034.2 074500 MOVE "06" TO IND-KEY. DB2034.2 074600 DELETE IND-FILE INVALID KEY GO TO ABORT-PGM. DB2034.2 074700 IF KEY-1 IS EQUAL TO 1 DB2034.2 074800 PERFORM PASS DB2034.2 074900 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2034.2 075000 PERFORM GEN-WRITE DB2034.2 075100 GO TO DELETE-TEST-1A DB2034.2 075200 ELSE PERFORM FAIL DB2034.2 075300 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK DB2034.2 075400 PERFORM GEN-WRITE DB2034.2 075500 PERFORM DELETE-DELETE-TEST-1-SUBTEST DB2034.2 075600 GO TO DELETE-TEST-2-INIT. DB2034.2 075700 DELETE-TEST-1-DELETE. DB2034.2 075800 PERFORM DE-LETE. DB2034.2 075900 PERFORM GEN-WRITE. DB2034.2 076000 PERFORM DELETE-DELETE-TEST-1-SUBTEST. DB2034.2 076100 GO TO DELETE-TEST-2-INIT. DB2034.2 076200 DELETE-DELETE-TEST-1-SUBTEST. DB2034.2 076300 MOVE "DELETE-TEST-1A" TO PAR-NAME. DB2034.2 076400 PERFORM DE-LETE. DB2034.2 076500 PERFORM GEN-WRITE. DB2034.2 076600 DELETE-TEST-1A. DB2034.2 076700 MOVE "DELETE-TEST-1A" TO PAR-NAME. DB2034.2 076800 IF CONTENTS-1 IS EQUAL TO SPACES DB2034.2 076900 PERFORM PASS DB2034.2 077000 ELSE PERFORM FAIL DB2034.2 077100 MOVE "(SPACES)" TO CORRECT-A DB2034.2 077200 MOVE CONTENTS-1 TO COMPUTED-A. DB2034.2 077300 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2034.2 077400 PERFORM GEN-WRITE. DB2034.2 077500 DELETE-TEST-2-INIT. DB2034.2 077600 MOVE "DELETE-TEST-2" TO PAR-NAME. DB2034.2 077700 MOVE "DEBUG DELETE INV KEY" TO FEATURE. DB2034.2 077800 MOVE 0 TO KEY-1. DB2034.2 077900 DELETE-TEST-2. DB2034.2 078000 MOVE "07" TO IND-KEY. DB2034.2 078100 DELETE IND-FILE INVALID KEY GO TO DELETE-TEST-2-CONT. DB2034.2 078200 DELETE-TEST-2-DELETE. DB2034.2 078300 PERFORM DE-LETE. DB2034.2 078400 PERFORM GEN-WRITE. DB2034.2 078500 GO TO CLOSE-IND-FILE. DB2034.2 078600 DELETE-TEST-2-CONT. DB2034.2 078700 IF KEY-1 IS EQUAL TO 1 DB2034.2 078800 PERFORM PASS DB2034.2 078900 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2034.2 079000 ELSE PERFORM FAIL DB2034.2 079100 MOVE "DEBUG PROC NOT EXECUTED" TO RE-MARK. DB2034.2 079200 PERFORM GEN-WRITE. DB2034.2 079300 GO TO CLOSE-IND-FILE. DB2034.2 079400 GEN-WRITE. DB2034.2 079500 PERFORM PRINT-DETAIL. DB2034.2 079600 ABORT-PGM. DB2034.2 079700 DISPLAY "INDEXED I-O MODULE - FILE HANDLING ERROR - PROGRAM ADB2034.2 079800- "BORTED." UPON THE-SYSTEM-PRINTER. DB2034.2 079900 CLOSE-IND-FILE. DB2034.2 080000 CLOSE IND-FILE. DB2034.2 080100 OPEN-IND-FILE. DB2034.2 080200 OPEN INPUT IND-FILE. DB2034.2 080300 MOVE SPACES TO PRINT-REC. DB2034.2 080400 PERFORM WRITE-LINE. DB2034.2 080500 MOVE " DUMP OF IND-FILE FOLLOWS" TO PRINT-REC. DB2034.2 080600 PERFORM WRITE-LINE. DB2034.2 080700 READ-IND-FILE. DB2034.2 080800 READ IND-FILE NEXT RECORD AT END GO TO CLOSE-FILE-DUMP. DB2034.2 080900 MOVE IND-REC-1H TO PRINT-REC. DB2034.2 --> -------------------- --> maximum size reached --> -------------------- ¤ Dauer der Verarbeitung: 0.100 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.Bot Zugriff |
