|
000100 IDENTIFICATION DIVISION. DB2044.2
000200 PROGRAM-ID. DB2044.2
000300 DB204A. DB2044.2
000400 AUTHOR. DB2044.2
000500 FEDERAL COMPILER TESTING CENTER. DB2044.2
000600 INSTALLATION. DB2044.2
000700 GENERAL SERVICES ADMINISTRATION DB2044.2
000800 AUTOMATED DATA AND TELECOMMUNICATION SERVICE. DB2044.2
000900 SOFTWARE DEVELOPMENT OFFICE. DB2044.2
001000 5203 LEESBURG PIKE SUITE 1100 DB2044.2
001100 FALLS CHURCH VIRGINIA 22041. DB2044.2
001200 DB2044.2
001300 PHONE (703) 756-6153 DB2044.2
001400 DB2044.2
001500 " HIGH ". DB2044.2
001600 DATE-WRITTEN. DB2044.2
001700 CCVS-74 VERSION 4.0 - 1980 JULY 1. DB2044.2
001800 CREATION DATE / VALIDATION DATE DB2044.2
001900 "4.2 ". DB2044.2
002000 SECURITY. DB2044.2
002100 NONE. DB2044.2
002200* DB2044.2
002300* * * * * * * * * * * * * * * * * * * * * *DB2044.2
002400* DB2044.2
002500* PROGRAM ABSTRACT DB2044.2
002600* DB2044.2
002700* DB204A TESTS THE CAPABILITY OF THE DEBUG MODULE TO HANDLE A DB2044.2
002800* DEBUGGING PROCEDURE WHICH IS MONITORING A "MERGE OUTPUT" DB2044.2
002900* PROCEDURE. THIS PROGRAM IS TO BE COMPILED AND EXECUTED DB2044.2
003000* WITH BOTH COMPILE AND OBJECT TIME DEBUGGING SWITCHES ON. DB2044.2
003100* THE DEBUGGING PROCEDURE SHOULD BE INCLUDED IN COMPILATION DB2044.2
003200* AND GENERATE CODE. DURING EXECUTION, TWO SEQUENTIAL FILES DB2044.2
003300* ARE CREATED WITH EACH CONTAINING 80-CHARACTER RECORDS IN DB2044.2
003400* SORTED ORDER. THE TWO FILES ARE THEN MERGED. EXECUTION DB2044.2
003500* OF THE MERGE OPERATION SHOULD TRIGGER THE DEBUGGING PRO- DB2044.2
003600* CEDURE LINKED TO THE MERGE OUTPUT PROCEDURE-NAME. DB2044.2
003700* DB2044.2
003800* DB2044.2
003900* DB2044.2
004000 ENVIRONMENT DIVISION. DB2044.2
004100 CONFIGURATION SECTION. DB2044.2
004200 SOURCE-COMPUTER. DB2044.2
004300 Card0130 DB2044.2
004400 WITH DEBUGGING MODE. DB2044.2
004500 OBJECT-COMPUTER. DB2044.2
004600 Card0131. DB2044.2
004700 INPUT-OUTPUT SECTION. DB2044.2
004800 FILE-CONTROL. DB2044.2
004900 SELECT PRINT-FILE ASSIGN TO DB2044.2
005000 "C0085" . DB2044.2
005100 SELECT SQ-FS1 ASSIGN TO DB2044.2
005200 "C0020" . DB2044.2
005300 SELECT SQ-FS2 ASSIGN TO DB2044.2
005400 "C0021" . DB2044.2
005500 SELECT SQ-FS3 ASSIGN TO DB2044.2
005600 "C0022" . DB2044.2
005700 SELECT ST-FS4 ASSIGN TO DB2044.2
005800 "C0039" . DB2044.2
005900 DATA DIVISION. DB2044.2
006000 FILE SECTION. DB2044.2
006100 FD PRINT-FILE DB2044.2
006200 LABEL RECORDS DB2044.2
006300 Card0132 DB2044.2
006400 DATA RECORD IS PRINT-REC DUMMY-RECORD. DB2044.2
006500 01 PRINT-REC PICTURE X(120). DB2044.2
006600 01 DUMMY-RECORD PICTURE X(120). DB2044.2
006700 FD SQ-FS1 DB2044.2
006800 VALUE OF DB2044.2
006900 Impl1 DB2044.2
007000* XXXXX074 REPLACE WITH IMPLEMENTOR NAME (*OPT C ONLY) DB2044.2
007100 IS DB2044.2
007200 4711 DB2044.2
007300* XXXXX075 REPLACE WITH VALUE CLAUSE OBJECT (*OPT C ONLY) DB2044.2
007400 DB2044.2
007500* XXXXX069 REPLACE WITH ADDITIONAL INFO (*OPT G ONLY) DB2044.2
007600 LABEL RECORDS ARE STANDARD. DB2044.2
007700 01 REC-1 PIC X(120). DB2044.2
007800 FD SQ-FS2 DB2044.2
007900 VALUE OF DB2044.2
008000 Impl1 DB2044.2
008100* XXXXX074 REPLACE WITH IMPLEMENTOR NAME (*OPT C ONLY) DB2044.2
008200 IS DB2044.2
008300 4711 DB2044.2
008400* XXXXX076 REPLACE WITH VALUE CLAUSE OBJECT (*OPT C ONLY) DB2044.2
008500 DB2044.2
008600* XXXXX069 REPLACE WITH ADDITIONAL INFO (*OPT G ONLY) DB2044.2
008700 LABEL RECORDS ARE STANDARD. DB2044.2
008800 01 REC-2 PIC X(120). DB2044.2
008900 FD SQ-FS3 DB2044.2
009000 VALUE OF DB2044.2
009100 Impl1 DB2044.2
009200* XXXXX074 REPLACE WITH IMPLEMENTOR NAME (*OPT C ONLY) DB2044.2
009300 IS DB2044.2
009400 4711 DB2044.2
009500* XXXXX077 REPLACE WITH VALUE CLAUSE OBJECT (*OPT C ONLY) DB2044.2
009600 DB2044.2
009700* XXXXX069 REPLACE WITH ADDITIONAL INFO (*OPT G ONLY) DB2044.2
009800 LABEL RECORDS ARE STANDARD. DB2044.2
009900 01 REC-3 PIC X(120). DB2044.2
010000 SD ST-FS4. DB2044.2
010100 01 REC-4. DB2044.2
010200 02 FILLER PIC X(34). DB2044.2
010300 02 SORT-KEY PIC X(6). DB2044.2
010400 02 FILLER PIC X(80). DB2044.2
010500 WORKING-STORAGE SECTION. DB2044.2
010600 01 ITEM-1. DB2044.2
010700 02 KEY-1 PIC 99. DB2044.2
010800 02 LINE-1 PIC X(6). DB2044.2
010900 02 NAME-1 PIC X(30). DB2044.2
011000 02 UNQUAL-NAME-1 PIC X(30). DB2044.2
011100 02 CONTENTS-1 PIC X(30). DB2044.2
011200 01 FILE-RECORD-INFORMATION-REC. DB2044.2
011300 03 FILE-RECORD-INFO-SKELETON. DB2044.2
011400 05 FILLER PICTURE X(48) VALUE DB2044.2
011500 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". DB2044.2
011600 05 FILLER PICTURE X(46) VALUE DB2044.2
011700 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". DB2044.2
011800 05 FILLER PICTURE X(26) VALUE DB2044.2
011900 ",LFIL=000000,ORG= ,LBLR= ". DB2044.2
012000 05 FILLER PICTURE X(37) VALUE DB2044.2
012100 ",RECKEY= ". DB2044.2
012200 05 FILLER PICTURE X(38) VALUE DB2044.2
012300 ",ALTKEY1= ". DB2044.2
012400 05 FILLER PICTURE X(38) VALUE DB2044.2
012500 ",ALTKEY2= ". DB2044.2
012600 05 FILLER PICTURE X(7) VALUE SPACE.DB2044.2
012700 03 FILE-RECORD-INFO OCCURS 10 TIMES. DB2044.2
012800 05 FILE-RECORD-INFO-P1-120. DB2044.2
012900 07 FILLER PIC X(5). DB2044.2
013000 07 XFILE-NAME PIC X(6). DB2044.2
013100 07 FILLER PIC X(8). DB2044.2
013200 07 XRECORD-NAME PIC X(6). DB2044.2
013300 07 FILLER PIC X(1). DB2044.2
013400 07 REELUNIT-NUMBER PIC 9(1). DB2044.2
013500 07 FILLER PIC X(7). DB2044.2
013600 07 XRECORD-NUMBER PIC 9(6). DB2044.2
013700 07 FILLER PIC X(6). DB2044.2
013800 07 UPDATE-NUMBER PIC 9(2). DB2044.2
013900 07 FILLER PIC X(5). DB2044.2
014000 07 ODO-NUMBER PIC 9(4). DB2044.2
014100 07 FILLER PIC X(5). DB2044.2
014200 07 XPROGRAM-NAME PIC X(5). DB2044.2
014300 07 FILLER PIC X(7). DB2044.2
014400 07 XRECORD-LENGTH PIC 9(6). DB2044.2
014500 07 FILLER PIC X(7). DB2044.2
014600 07 CHARS-OR-RECORDS PIC X(2). DB2044.2
014700 07 FILLER PIC X(1). DB2044.2
014800 07 XBLOCK-SIZE PIC 9(4). DB2044.2
014900 07 FILLER PIC X(6). DB2044.2
015000 07 RECORDS-IN-FILE PIC 9(6). DB2044.2
015100 07 FILLER PIC X(5). DB2044.2
015200 07 XFILE-ORGANIZATION PIC X(2). DB2044.2
015300 07 FILLER PIC X(6). DB2044.2
015400 07 XLABEL-TYPE PIC X(1). DB2044.2
015500 05 FILE-RECORD-INFO-P121-240. DB2044.2
015600 07 FILLER PIC X(8). DB2044.2
015700 07 XRECORD-KEY PIC X(29). DB2044.2
015800 07 FILLER PIC X(9). DB2044.2
015900 07 ALTERNATE-KEY1 PIC X(29). DB2044.2
016000 07 FILLER PIC X(9). DB2044.2
016100 07 ALTERNATE-KEY2 PIC X(29). DB2044.2
016200 07 FILLER PIC X(7). DB2044.2
016300 01 TEST-RESULTS. DB2044.2
016400 02 FILLER PICTURE X VALUE SPACE. DB2044.2
016500 02 FEATURE PICTURE X(20) VALUE SPACE. DB2044.2
016600 02 FILLER PICTURE X VALUE SPACE. DB2044.2
016700 02 P-OR-F PICTURE X(5) VALUE SPACE. DB2044.2
016800 02 FILLER PICTURE X VALUE SPACE. DB2044.2
016900 02 PAR-NAME. DB2044.2
017000 03 FILLER PICTURE X(12) VALUE SPACE. DB2044.2
017100 03 PARDOT-X PICTURE X VALUE SPACE. DB2044.2
017200 03 DOTVALUE PICTURE 99 VALUE ZERO. DB2044.2
017300 03 FILLER PIC X(5) VALUE SPACE. DB2044.2
017400 02 FILLER PIC X(10) VALUE SPACE. DB2044.2
017500 02 RE-MARK PIC X(61). DB2044.2
017600 01 TEST-COMPUTED. DB2044.2
017700 02 FILLER PIC X(30) VALUE SPACE. DB2044.2
017800 02 FILLER PIC X(17) VALUE " COMPUTED=". DB2044.2
017900 02 COMPUTED-X. DB2044.2
018000 03 COMPUTED-A PICTURE X(20) VALUE SPACE. DB2044.2
018100 03 COMPUTED-N REDEFINES COMPUTED-A PICTURE -9(9).9(9). DB2044.2
018200 03 COMPUTED-0V18 REDEFINES COMPUTED-A PICTURE -.9(18). DB2044.2
018300 03 COMPUTED-4V14 REDEFINES COMPUTED-A PICTURE -9(4).9(14). DB2044.2
018400 03 COMPUTED-14V4 REDEFINES COMPUTED-A PICTURE -9(14).9(4). DB2044.2
018500 03 CM-18V0 REDEFINES COMPUTED-A. DB2044.2
018600 04 COMPUTED-18V0 PICTURE -9(18). DB2044.2
018700 04 FILLER PICTURE X. DB2044.2
018800 03 FILLER PIC X(50) VALUE SPACE. DB2044.2
018900 01 TEST-CORRECT. DB2044.2
019000 02 FILLER PIC X(30) VALUE SPACE. DB2044.2
019100 02 FILLER PIC X(17) VALUE " CORRECT =". DB2044.2
019200 02 CORRECT-X. DB2044.2
019300 03 CORRECT-A PICTURE X(20) VALUE SPACE. DB2044.2
019400 03 CORRECT-N REDEFINES CORRECT-A PICTURE -9(9).9(9). DB2044.2
019500 03 CORRECT-0V18 REDEFINES CORRECT-A PICTURE -.9(18). DB2044.2
019600 03 CORRECT-4V14 REDEFINES CORRECT-A PICTURE -9(4).9(14). DB2044.2
019700 03 CORRECT-14V4 REDEFINES CORRECT-A PICTURE -9(14).9(4). DB2044.2
019800 03 CR-18V0 REDEFINES CORRECT-A. DB2044.2
019900 04 CORRECT-18V0 PICTURE -9(18). DB2044.2
020000 04 FILLER PICTURE X. DB2044.2
020100 03 FILLER PIC X(50) VALUE SPACE. DB2044.2
020200 01 CCVS-C-1. DB2044.2
020300 02 FILLER PICTURE IS X(99) VALUE IS " FEATURE PADB2044.2
020400- "SS PARAGRAPH-NAME DB2044.2
020500- " REMARKS". DB2044.2
020600 02 FILLER PICTURE IS X(20) VALUE IS SPACE. DB2044.2
020700 01 CCVS-C-2. DB2044.2
020800 02 FILLER PICTURE IS X VALUE IS SPACE. DB2044.2
020900 02 FILLER PICTURE IS X(6) VALUE IS "TESTED". DB2044.2
021000 02 FILLER PICTURE IS X(15) VALUE IS SPACE. DB2044.2
021100 02 FILLER PICTURE IS X(4) VALUE IS "FAIL". DB2044.2
021200 02 FILLER PICTURE IS X(94) VALUE IS SPACE. DB2044.2
021300 01 REC-SKL-SUB PICTURE 9(2) VALUE ZERO. DB2044.2
021400 01 REC-CT PICTURE 99 VALUE ZERO. DB2044.2
021500 01 DELETE-CNT PICTURE 999 VALUE ZERO. DB2044.2
021600 01 ERROR-COUNTER PICTURE IS 999 VALUE IS ZERO. DB2044.2
021700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. DB2044.2
021800 01 PASS-COUNTER PIC 999 VALUE ZERO. DB2044.2
021900 01 TOTAL-ERROR PIC 999 VALUE ZERO. DB2044.2
022000 01 ERROR-HOLD PIC 999 VALUE ZERO. DB2044.2
022100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. DB2044.2
022200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. DB2044.2
022300 01 CCVS-H-1. DB2044.2
022400 02 FILLER PICTURE X(27) VALUE SPACE. DB2044.2
022500 02 FILLER PICTURE X(67) VALUE DB2044.2
022600 " FEDERAL COMPILER TESTING CENTER COBOL COMPILER VALIDATION DB2044.2
022700- " SYSTEM". DB2044.2
022800 02 FILLER PICTURE X(26) VALUE SPACE. DB2044.2
022900 01 CCVS-H-2. DB2044.2
023000 02 FILLER PICTURE X(52) VALUE IS DB2044.2
023100 "CCVS74 NCC COPY, NOT FOR DISTRIBUTION.". DB2044.2
023200 02 FILLER PICTURE IS X(19) VALUE IS "TEST RESULTS SET- ". DB2044.2
023300 02 TEST-ID PICTURE IS X(9). DB2044.2
023400 02 FILLER PICTURE IS X(40) VALUE IS SPACE. DB2044.2
023500 01 CCVS-H-3. DB2044.2
023600 02 FILLER PICTURE X(34) VALUE DB2044.2
023700 " FOR OFFICIAL USE ONLY ". DB2044.2
023800 02 FILLER PICTURE X(58) VALUE DB2044.2
023900 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".DB2044.2
024000 02 FILLER PICTURE X(28) VALUE DB2044.2
024100 " COPYRIGHT 1974 ". DB2044.2
024200 01 CCVS-E-1. DB2044.2
024300 02 FILLER PICTURE IS X(52) VALUE IS SPACE. DB2044.2
024400 02 FILLER PICTURE IS X(14) VALUE IS "END OF TEST- ". DB2044.2
024500 02 ID-AGAIN PICTURE IS X(9). DB2044.2
024600 02 FILLER PICTURE X(45) VALUE IS DB2044.2
024700 " NTIS DISTRIBUTION COBOL 74". DB2044.2
024800 01 CCVS-E-2. DB2044.2
024900 02 FILLER PICTURE X(31) VALUE DB2044.2
025000 SPACE. DB2044.2
025100 02 FILLER PICTURE X(21) VALUE SPACE. DB2044.2
025200 02 CCVS-E-2-2. DB2044.2
025300 03 ERROR-TOTAL PICTURE IS XXX VALUE IS SPACE. DB2044.2
025400 03 FILLER PICTURE IS X VALUE IS SPACE. DB2044.2
025500 03 ENDER-DESC PIC X(44) VALUE "ERRORS ENCOUNTERED". DB2044.2
025600 01 CCVS-E-3. DB2044.2
025700 02 FILLER PICTURE X(22) VALUE DB2044.2
025800 " FOR OFFICIAL USE ONLY". DB2044.2
025900 02 FILLER PICTURE X(12) VALUE SPACE. DB2044.2
026000 02 FILLER PICTURE X(58) VALUE DB2044.2
026100 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".DB2044.2
026200 02 FILLER PICTURE X(13) VALUE SPACE. DB2044.2
026300 02 FILLER PIC X(15) VALUE " COPYRIGHT 1974". DB2044.2
026400 01 CCVS-E-4. DB2044.2
026500 02 CCVS-E-4-1 PIC XXX VALUE SPACE. DB2044.2
026600 02 FILLER PIC XXXX VALUE " OF ". DB2044.2
026700 02 CCVS-E-4-2 PIC XXX VALUE SPACE. DB2044.2
026800 02 FILLER PIC X(40) VALUE DB2044.2
026900 " TESTS WERE EXECUTED SUCCESSFULLY". DB2044.2
027000 01 XXINFO. DB2044.2
027100 02 FILLER PIC X(30) VALUE " *** INFORMATION ***". DB2044.2
027200 02 INFO-TEXT. DB2044.2
027300 04 FILLER PIC X(20) VALUE SPACE. DB2044.2
027400 04 XXCOMPUTED PIC X(20). DB2044.2
027500 04 FILLER PIC X(5) VALUE SPACE. DB2044.2
027600 04 XXCORRECT PIC X(20). DB2044.2
027700 01 HYPHEN-LINE. DB2044.2
027800 02 FILLER PICTURE IS X VALUE IS SPACE. DB2044.2
027900 02 FILLER PICTURE IS X(65) VALUE IS "************************DB2044.2
028000- "*****************************************". DB2044.2
028100 02 FILLER PICTURE IS X(54) VALUE IS "************************DB2044.2
028200- "******************************". DB2044.2
028300 01 CCVS-PGM-ID PIC X(6) VALUE DB2044.2
028400 "DB204A". DB2044.2
028500 PROCEDURE DIVISION. DB2044.2
028600 DECLARATIVES. DB2044.2
028700 MERGE-PROC SECTION. DB2044.2
028800 USE FOR DEBUGGING ON MERGE-OUTPUT-PROC. DB2044.2
028900 MERGE-1. DB2044.2
029000 ADD 1 TO KEY-1. DB2044.2
029100 MOVE DEBUG-LINE TO LINE-1. DB2044.2
029200 MOVE DEBUG-NAME TO NAME-1 UNQUAL-NAME-1. DB2044.2
029300 MOVE DEBUG-CONTENTS TO CONTENTS-1. DB2044.2
029400 INSPECT UNQUAL-NAME-1 REPLACING CHARACTERS BY SPACES DB2044.2
029500 AFTER INITIAL SPACE. DB2044.2
029600 END DECLARATIVES. DB2044.2
029700 CCVS1 SECTION. DB2044.2
029800 OPEN-FILES. DB2044.2
029900 OPEN OUTPUT PRINT-FILE. DB2044.2
030000 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. DB2044.2
030100 MOVE SPACE TO TEST-RESULTS. DB2044.2
030200 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. DB2044.2
030300 GO TO CCVS1-EXIT. DB2044.2
030400 CLOSE-FILES. DB2044.2
030500 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. DB2044.2
030600 TERMINATE-CCVS. DB2044.2
030700 EXIT PROGRAM. DB2044.2
030800 TERMINATE-CALL. DB2044.2
030900 STOP RUN. DB2044.2
031000 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. DB2044.2
031100 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. DB2044.2
031200 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. DB2044.2
031300 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-CNT. DB2044.2
031400 MOVE "****TEST DELETED****" TO RE-MARK. DB2044.2
031500 PRINT-DETAIL. DB2044.2
031600 IF REC-CT NOT EQUAL TO ZERO DB2044.2
031700 MOVE "." TO PARDOT-X DB2044.2
031800 MOVE REC-CT TO DOTVALUE. DB2044.2
031900 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. DB2044.2
032000 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE DB2044.2
032100 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX DB2044.2
032200 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. DB2044.2
032300 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. DB2044.2
032400 MOVE SPACE TO CORRECT-X. DB2044.2
032500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. DB2044.2
032600 MOVE SPACE TO RE-MARK. DB2044.2
032700 HEAD-ROUTINE. DB2044.2
032800 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2044.2
032900 MOVE CCVS-H-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES. DB2044.2
033000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. DB2044.2
033100 COLUMN-NAMES-ROUTINE. DB2044.2
033200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2044.2
033300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2044.2
033400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2044.2
033500 END-ROUTINE. DB2044.2
033600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.DB2044.2
033700 END-RTN-EXIT. DB2044.2
033800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2044.2
033900 END-ROUTINE-1. DB2044.2
034000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO DB2044.2
034100 ERROR-HOLD. ADD DELETE-CNT TO ERROR-HOLD. DB2044.2
034200 ADD PASS-COUNTER TO ERROR-HOLD. DB2044.2
034300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. DB2044.2
034400 MOVE PASS-COUNTER TO CCVS-E-4-1. DB2044.2
034500 MOVE ERROR-HOLD TO CCVS-E-4-2. DB2044.2
034600 MOVE CCVS-E-4 TO CCVS-E-2-2. DB2044.2
034700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. DB2044.2
034800 END-ROUTINE-12. DB2044.2
034900 MOVE "TEST(S) FAILED" TO ENDER-DESC. DB2044.2
035000 IF ERROR-COUNTER IS EQUAL TO ZERO DB2044.2
035100 MOVE "NO " TO ERROR-TOTAL DB2044.2
035200 ELSE DB2044.2
035300 MOVE ERROR-COUNTER TO ERROR-TOTAL. DB2044.2
035400 MOVE CCVS-E-2 TO DUMMY-RECORD. DB2044.2
035500 PERFORM WRITE-LINE. DB2044.2
035600 END-ROUTINE-13. DB2044.2
035700 IF DELETE-CNT IS EQUAL TO ZERO DB2044.2
035800 MOVE "NO " TO ERROR-TOTAL ELSE DB2044.2
035900 MOVE DELETE-CNT TO ERROR-TOTAL. DB2044.2
036000 MOVE "TEST(S) DELETED " TO ENDER-DESC. DB2044.2
036100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2044.2
036200 IF INSPECT-COUNTER EQUAL TO ZERO DB2044.2
036300 MOVE "NO " TO ERROR-TOTAL DB2044.2
036400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. DB2044.2
036500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. DB2044.2
036600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2044.2
036700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. DB2044.2
036800 WRITE-LINE. DB2044.2
036900 ADD 1 TO RECORD-COUNT. DB2044.2
037000 IF RECORD-COUNT GREATER 50 DB2044.2
037100 MOVE DUMMY-RECORD TO DUMMY-HOLD DB2044.2
037200 MOVE SPACE TO DUMMY-RECORD DB2044.2
037300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE DB2044.2
037400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN DB2044.2
037500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES DB2044.2
037600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN DB2044.2
037700 MOVE DUMMY-HOLD TO DUMMY-RECORD DB2044.2
037800 MOVE ZERO TO RECORD-COUNT. DB2044.2
037900 PERFORM WRT-LN. DB2044.2
038000 WRT-LN. DB2044.2
038100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. DB2044.2
038200 MOVE SPACE TO DUMMY-RECORD. DB2044.2
038300 BLANK-LINE-PRINT. DB2044.2
038400 PERFORM WRT-LN. DB2044.2
038500 FAIL-ROUTINE. DB2044.2
038600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. DB2044.2
038700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. DB2044.2
038800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. DB2044.2
038900 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2044.2
039000 GO TO FAIL-ROUTINE-EX. DB2044.2
039100 FAIL-ROUTINE-WRITE. DB2044.2
039200 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE DB2044.2
039300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. DB2044.2
039400 FAIL-ROUTINE-EX. EXIT. DB2044.2
039500 BAIL-OUT. DB2044.2
039600 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. DB2044.2
039700 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. DB2044.2
039800 BAIL-OUT-WRITE. DB2044.2
039900 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. DB2044.2
040000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. DB2044.2
040100 BAIL-OUT-EX. EXIT. DB2044.2
040200 CCVS1-EXIT. DB2044.2
040300 EXIT. DB2044.2
040400 CREATE-INPUT-FILES SECTION. DB2044.2
040500 SET-UP-REC-AREAS. DB2044.2
040600 MOVE FILE-RECORD-INFO-SKELETON TO FILE-RECORD-INFO (1) DB2044.2
040700 FILE-RECORD-INFO (2). DB2044.2
040800 MOVE "SQ-FS1" TO XFILE-NAME (1). DB2044.2
040900 MOVE "SQ-FS2" TO XFILE-NAME (2). DB2044.2
041000 MOVE "REC-1" TO XRECORD-NAME (1). DB2044.2
041100 MOVE "REC-2" TO XRECORD-NAME (2). DB2044.2
041200 MOVE ".XXX." TO XPROGRAM-NAME (1) DB2044.2
041300 XPROGRAM-NAME (2). DB2044.2
041400 MOVE 120 TO XRECORD-LENGTH (1) DB2044.2
041500 XRECORD-LENGTH (2). DB2044.2
041600 MOVE "RC" TO CHARS-OR-RECORDS (1) DB2044.2
041700 CHARS-OR-RECORDS (2). DB2044.2
041800 MOVE 1 TO XBLOCK-SIZE (1) DB2044.2
041900 XBLOCK-SIZE (2). DB2044.2
042000 MOVE 10 TO RECORDS-IN-FILE (1) DB2044.2
042100 RECORDS-IN-FILE (2). DB2044.2
042200 MOVE "SQ" TO XFILE-ORGANIZATION (1) DB2044.2
042300 XFILE-ORGANIZATION (2). DB2044.2
042400 MOVE "S" TO XLABEL-TYPE (1) DB2044.2
042500 XLABEL-TYPE (2). DB2044.2
042600 OPEN OUTPUT SQ-FS1 SQ-FS2. DB2044.2
042700 WRITE-FILES. DB2044.2
042800 MOVE 1 TO XRECORD-NUMBER (1). DB2044.2
042900 MOVE 2 TO XRECORD-NUMBER (2). DB2044.2
043000 PERFORM WRITE-FILES-SUBROUTINE 10 TIMES. DB2044.2
043100 CLOSE SQ-FS1 SQ-FS2. DB2044.2
043200 GO TO BEGIN-DB204A-TESTS. DB2044.2
043300 WRITE-FILES-SUBROUTINE. DB2044.2
043400 MOVE FILE-RECORD-INFO (1) TO REC-1. DB2044.2
043500 WRITE REC-1. DB2044.2
043600 ADD 2 TO XRECORD-NUMBER (1). DB2044.2
043700 MOVE FILE-RECORD-INFO (2) TO REC-2. DB2044.2
043800 WRITE REC-2. DB2044.2
043900 ADD 2 TO XRECORD-NUMBER (2). DB2044.2
044000 BEGIN-DB204A-TESTS SECTION. DB2044.2
044100 MERGE-TEST-INIT. DB2044.2
044200 MOVE "MERGE-TEST" TO PAR-NAME. DB2044.2
044300 MOVE "MERGE OUTPUT PROC" TO FEATURE. DB2044.2
044400 MOVE SPACES TO ITEM-1. DB2044.2
044500 MOVE 0 TO KEY-1. DB2044.2
044600******************************************************************DB2044.2
044700* THE DEBUG-LINE (INSPT) TEST NAMED IN THE OUTPUT REPORT AS *DB2044.2
044800* "MERGE-TEST-A" SHOULD POINT TO THE EXECUTABLE STATEMENT *DB2044.2
044900* WHICH FOLLOWS THIS COMMENT SET AND WHICH READS, "MERGE *DB2044.2
045000* ST-FS4 ON ASCENDING KEY SORT-KEY USING SQ-FS1 SQ-FS2 *DB2044.2
045100* OUTPUT PROCEDURE IS MERGE-OUTPUT-PROC.". *DB2044.2
045200******************************************************************DB2044.2
045300 MERGE-TEST. DB2044.2
045400 MERGE ST-FS4 ON ASCENDING KEY SORT-KEY DB2044.2
045500 USING SQ-FS1 SQ-FS2 DB2044.2
045600 OUTPUT PROCEDURE IS MERGE-OUTPUT-PROC. DB2044.2
045700 IF KEY-1 IS EQUAL TO 1 DB2044.2
045800 PERFORM PASS DB2044.2
045900 MOVE "DEBUG PROC WAS EXECUTED" TO RE-MARK DB2044.2
046000 ELSE PERFORM FAIL DB2044.2
046100 MOVE "NO. TIMES DEBUG PROC EXECUTED" TO RE-MARK DB2044.2
046200 MOVE 1 TO CORRECT-18V0 DB2044.2
046300 MOVE KEY-1 TO COMPUTED-18V0. DB2044.2
046400 PERFORM PRINT-DETAIL DB2044.2
046500 IF KEY-1 IS EQUAL TO 0 DB2044.2
046600 PERFORM DELETE-MERGE-TEST-SUBTESTS DB2044.2
046700 GO TO END-OF-DB204A DB2044.2
046800 ELSE GO TO MERGE-TEST-A. DB2044.2
046900 MERGE-TEST-DELETE. DB2044.2
047000 PERFORM DE-LETE. DB2044.2
047100 PERFORM PRINT-DETAIL. DB2044.2
047200 PERFORM DELETE-MERGE-TEST-SUBTESTS. DB2044.2
047300 GO TO END-OF-DB204A. DB2044.2
047400 DELETE-MERGE-TEST-SUBTESTS. DB2044.2
047500 MOVE "MERGE-TEST-A" TO PAR-NAME. DB2044.2
047600 PERFORM DE-LETE. DB2044.2
047700 PERFORM PRINT-DETAIL. DB2044.2
047800 MOVE "MERGE-TEST-B" TO PAR-NAME. DB2044.2
047900 PERFORM DE-LETE. DB2044.2
048000 PERFORM PRINT-DETAIL. DB2044.2
048100 MOVE "MERGE-TEST-C" TO PAR-NAME. DB2044.2
048200 PERFORM DE-LETE. DB2044.2
048300 PERFORM PRINT-DETAIL. DB2044.2
048400 MERGE-TEST-A. DB2044.2
048500 MOVE "MERGE-TEST-A" TO PAR-NAME. DB2044.2
048600 MOVE "DEBUG-LINE; SEE NEXT LINE" TO RE-MARK. DB2044.2
048700 MOVE "<=== DEBUG-LINE" TO CORRECT-A. DB2044.2
048800 MOVE LINE-1 TO COMPUTED-A. DB2044.2
048900 PERFORM INSPT. DB2044.2
049000 PERFORM PRINT-DETAIL. DB2044.2
049100 MERGE-TEST-B. DB2044.2
049200 MOVE "MERGE-TEST-B" TO PAR-NAME. DB2044.2
049300 IF UNQUAL-NAME-1 IS EQUAL TO "MERGE-OUTPUT-PROC" DB2044.2
049400 PERFORM PASS DB2044.2
049500 ELSE PERFORM FAIL DB2044.2
049600 MOVE "MERGE-OUTPUT-PROC" TO CORRECT-A DB2044.2
049700 MOVE NAME-1 TO COMPUTED-A. DB2044.2
049800 MOVE "DEBUG-NAME" TO RE-MARK DB2044.2
049900 PERFORM PRINT-DETAIL. DB2044.2
050000 MERGE-TEST-C. DB2044.2
050100 MOVE "MERGE-TEST-C" TO PAR-NAME. DB2044.2
050200 IF CONTENTS-1 IS EQUAL TO "MERGE OUTPUT" DB2044.2
050300 PERFORM PASS DB2044.2
050400 ELSE PERFORM FAIL DB2044.2
050500 MOVE "MERGE OUTPUT" TO CORRECT-A DB2044.2
050600 MOVE CONTENTS-1 TO COMPUTED-A. DB2044.2
050700 MOVE "DEBUG-CONTENTS" TO RE-MARK. DB2044.2
050800 PERFORM PRINT-DETAIL. DB2044.2
050900 GO TO END-OF-DB204A. DB2044.2
051000 MERGE-OUTPUT-PROC SECTION. DB2044.2
051100 OPEN-OUTPUT-FILE. DB2044.2
051200 OPEN OUTPUT SQ-FS3. DB2044.2
051300 RETURN-RECORDS. DB2044.2
051400 RETURN ST-FS4 RECORD INTO REC-3 DB2044.2
051500 AT END GO TO CLOSE-OUTPUT-FILE. DB2044.2
051600 WRITE REC-3. DB2044.2
051700 GO TO RETURN-RECORDS. DB2044.2
051800 CLOSE-OUTPUT-FILE. DB2044.2
051900 CLOSE SQ-FS3. DB2044.2
052000 END-OF-DB204A SECTION. DB2044.2
052100 DUMP-SQ-FS1. DB2044.2
052200 OPEN INPUT SQ-FS1. DB2044.2
052300 MOVE "DUMP OF SQ-FS1 FOLLOWS:" TO PRINT-REC. DB2044.2
052400 PERFORM WRITE-LINE. DB2044.2
052500 READ-SQ-FS1. DB2044.2
052600 READ SQ-FS1 AT END GO TO DUMP-SQ-FS2. DB2044.2
052700 MOVE REC-1 TO PRINT-REC. DB2044.2
052800 PERFORM WRITE-LINE. DB2044.2
052900 GO TO READ-SQ-FS1. DB2044.2
053000 DUMP-SQ-FS2. DB2044.2
053100 CLOSE SQ-FS1. DB2044.2
053200 OPEN INPUT SQ-FS2. DB2044.2
053300 MOVE "DUMP OF SQ-FS2 FOLLOWS:" TO PRINT-REC. DB2044.2
053400 PERFORM WRITE-LINE. DB2044.2
053500 READ-SQ-FS2. DB2044.2
053600 READ SQ-FS2 AT END GO TO DUMP-SQ-FS3. DB2044.2
053700 MOVE REC-2 TO PRINT-REC. DB2044.2
053800 PERFORM WRITE-LINE. DB2044.2
053900 GO TO READ-SQ-FS2. DB2044.2
054000 DUMP-SQ-FS3. DB2044.2
054100 CLOSE SQ-FS2. DB2044.2
054200 OPEN INPUT SQ-FS3. DB2044.2
054300 MOVE "DUMP OF SQ-FS3 FOLLOWS:" TO PRINT-REC. DB2044.2
054400 PERFORM WRITE-LINE. DB2044.2
054500 READ-SQ-FS3. DB2044.2
054600 READ SQ-FS3 AT END GO TO END-OF-TESTS. DB2044.2
054700 MOVE REC-3 TO PRINT-REC. DB2044.2
054800 PERFORM WRITE-LINE. DB2044.2
054900 GO TO READ-SQ-FS3. DB2044.2
055000 END-OF-TESTS. DB2044.2
055100 EXIT. DB2044.2
055200 CCVS-EXIT SECTION. DB2044.2
055300 CCVS-999999. DB2044.2
055400 GO TO CLOSE-FILES. DB2044.2
¤ Dauer der Verarbeitung: 0.37 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.
|
