| Quellcodebibliothek Statistik Leitseite products/Sources/formale Sprachen/Cobol/Test-Suite/COBOL/SQ/ Datei vom 4.1.2008 mit Größe 49 kB |
|
Quelle sq147a.cob Sprache: Cobol |
|||||||||
|
000100 IDENTIFICATION DIVISION. SQ1474.2
000200 PROGRAM-ID. SQ1474.2 000300 SQ147A. SQ1474.2 000400**************************************************************** SQ1474.2 000500* * SQ1474.2 000600* VALIDATION FOR:- * SQ1474.2 000700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1474.2 000800* USING CCVS85 VERSION 3.0. * SQ1474.2 000900* * SQ1474.2 001000* CREATION DATE / VALIDATION DATE * SQ1474.2 001100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1474.2 001200* * SQ1474.2 001300**************************************************************** SQ1474.2 001400* * SQ1474.2 001500* X-CARDS USED BY THIS PROGRAM ARE :- * SQ1474.2 001600* * SQ1474.2 001700* X-14 SEQUENTIAL MASS STORAGE FILE. * SQ1474.2 001800* X-55 SYSTEM PRINTER * SQ1474.2 001900* X-82 SOURCE-COMPUTER * SQ1474.2 002000* X-83 OBJECT-COMPUTER * SQ1474.2 002100* X-84 LABEL RECORDS OPTION. * SQ1474.2 002200* * SQ1474.2 002300**************************************************************** SQ1474.2 002400* * SQ1474.2 002500* THIS PROGRAM CHECKS FOR THE CORRECT RESPONSE TO READING * SQ1474.2 002600* A CLOSED FILE. THE TEST FOR CORRECT I-O STATUS CODE 47 * SQ1474.2 002700* IS IN THE DECLARATIVES. AN ABNORMAL TERMINATION IS * SQ1474.2 002800* POSSIBLE AFTER THE TEST OF THE I-O STATUS CODE IS * SQ1474.2 002900* ACCOMPLISHED BUT BEFORE CONTROL IS RETURNED TO THE MAIN * SQ1474.2 003000* LINE CODE. * SQ1474.2 003100* * SQ1474.2 003200**************************************************************** SQ1474.2 003300* SQ1474.2 003400 ENVIRONMENT DIVISION. SQ1474.2 003500 CONFIGURATION SECTION. SQ1474.2 003600 SOURCE-COMPUTER. SQ1474.2 003700 Card0130. SQ1474.2 003800 OBJECT-COMPUTER. SQ1474.2 003900 Card0131. SQ1474.2 004000* SQ1474.2 004100 INPUT-OUTPUT SECTION. SQ1474.2 004200 FILE-CONTROL. SQ1474.2 004300 SELECT PRINT-FILE ASSIGN TO SQ1474.2 004400 "C0085" . SQ1474.2 004500* SQ1474.2 004600 SELECT SQ-FS1 ASSIGN TO SQ1474.2 004700 "C0020" SQ1474.2 004800 FILE STATUS SQ-FS1-STATUS. SQ1474.2 004900* SQ1474.2 005000* SQ1474.2 005100 DATA DIVISION. SQ1474.2 005200 FILE SECTION. SQ1474.2 005300 FD PRINT-FILE SQ1474.2 005400 LABEL RECORDS SQ1474.2 005500 Card0132 SQ1474.2 005600 DATA RECORD IS PRINT-REC DUMMY-RECORD SQ1474.2 005700 . SQ1474.2 005800 01 PRINT-REC PICTURE X(120). SQ1474.2 005900 01 DUMMY-RECORD PICTURE X(120). SQ1474.2 006000* SQ1474.2 006100 FD SQ-FS1 SQ1474.2 006200 LABEL RECORD IS STANDARD SQ1474.2 006300 . SQ1474.2 006400 01 SQ-FS1R1-F-G-120 PIC X(120). SQ1474.2 006500* SQ1474.2 006600 WORKING-STORAGE SECTION. SQ1474.2 006700* SQ1474.2 006800*************************************************************** SQ1474.2 006900* * SQ1474.2 007000* WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE * SQ1474.2 007100* * SQ1474.2 007200*************************************************************** SQ1474.2 007300* SQ1474.2 007400 01 SQ-FS1-STATUS. SQ1474.2 007500 03 SQ-FS1-KEY-1 PIC X. SQ1474.2 007600 03 SQ-FS1-KEY-2 PIC X. SQ1474.2 007700* SQ1474.2 007800* SQ1474.2 007900*************************************************************** SQ1474.2 008000* * SQ1474.2 008100* WORKING-STORAGE DATA ITEMS USED BY THE CCVS * SQ1474.2 008200* * SQ1474.2 008300*************************************************************** SQ1474.2 008400* SQ1474.2 008500 01 REC-SKEL-SUB PIC 99. SQ1474.2 008600* SQ1474.2 008700 01 FILE-RECORD-INFORMATION-REC. SQ1474.2 008800 03 FILE-RECORD-INFO-SKELETON. SQ1474.2 008900 05 FILLER PICTURE X(48) VALUE SQ1474.2 009000 "FILE= ,RECORD= /0,RECNO=000000,UPDT=00". SQ1474.2 009100 05 FILLER PICTURE X(46) VALUE SQ1474.2 009200 ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000". SQ1474.2 009300 05 FILLER PICTURE X(26) VALUE SQ1474.2 009400 ",LFIL=000000,ORG= ,LBLR= ". SQ1474.2 009500 05 FILLER PICTURE X(37) VALUE SQ1474.2 009600 ",RECKEY= ". SQ1474.2 009700 05 FILLER PICTURE X(38) VALUE SQ1474.2 009800 ",ALTKEY1= ". SQ1474.2 009900 05 FILLER PICTURE X(38) VALUE SQ1474.2 010000 ",ALTKEY2= ". SQ1474.2 010100 05 FILLER PICTURE X(7) VALUE SPACE.SQ1474.2 010200 03 FILE-RECORD-INFO OCCURS 10 TIMES. SQ1474.2 010300 05 FILE-RECORD-INFO-P1-120. SQ1474.2 010400 07 FILLER PIC X(5). SQ1474.2 010500 07 XFILE-NAME PIC X(6). SQ1474.2 010600 07 FILLER PIC X(8). SQ1474.2 010700 07 XRECORD-NAME PIC X(6). SQ1474.2 010800 07 FILLER PIC X(1). SQ1474.2 010900 07 REELUNIT-NUMBER PIC 9(1). SQ1474.2 011000 07 FILLER PIC X(7). SQ1474.2 011100 07 XRECORD-NUMBER PIC 9(6). SQ1474.2 011200 07 FILLER PIC X(6). SQ1474.2 011300 07 UPDATE-NUMBER PIC 9(2). SQ1474.2 011400 07 FILLER PIC X(5). SQ1474.2 011500 07 ODO-NUMBER PIC 9(4). SQ1474.2 011600 07 FILLER PIC X(5). SQ1474.2 011700 07 XPROGRAM-NAME PIC X(5). SQ1474.2 011800 07 FILLER PIC X(7). SQ1474.2 011900 07 XRECORD-LENGTH PIC 9(6). SQ1474.2 012000 07 FILLER PIC X(7). SQ1474.2 012100 07 CHARS-OR-RECORDS PIC X(2). SQ1474.2 012200 07 FILLER PIC X(1). SQ1474.2 012300 07 XBLOCK-SIZE PIC 9(4). SQ1474.2 012400 07 FILLER PIC X(6). SQ1474.2 012500 07 RECORDS-IN-FILE PIC 9(6). SQ1474.2 012600 07 FILLER PIC X(5). SQ1474.2 012700 07 XFILE-ORGANIZATION PIC X(2). SQ1474.2 012800 07 FILLER PIC X(6). SQ1474.2 012900 07 XLABEL-TYPE PIC X(1). SQ1474.2 013000 05 FILE-RECORD-INFO-P121-240. SQ1474.2 013100 07 FILLER PIC X(8). SQ1474.2 013200 07 XRECORD-KEY PIC X(29). SQ1474.2 013300 07 FILLER PIC X(9). SQ1474.2 013400 07 ALTERNATE-KEY1 PIC X(29). SQ1474.2 013500 07 FILLER PIC X(9). SQ1474.2 013600 07 ALTERNATE-KEY2 PIC X(29). SQ1474.2 013700 07 FILLER PIC X(7). SQ1474.2 013800* SQ1474.2 013900 01 TEST-RESULTS. SQ1474.2 014000 02 FILLER PIC X VALUE SPACE. SQ1474.2 014100 02 PAR-NAME. SQ1474.2 014200 03 FILLER PIC X(14) VALUE SPACE. SQ1474.2 014300 03 PARDOT-X PIC X VALUE SPACE. SQ1474.2 014400 03 DOTVALUE PIC 99 VALUE ZERO. SQ1474.2 014500 02 FILLER PIC X VALUE SPACE. SQ1474.2 014600 02 FEATURE PIC X(24) VALUE SPACE. SQ1474.2 014700 02 FILLER PIC X VALUE SPACE. SQ1474.2 014800 02 P-OR-F PIC X(5) VALUE SPACE. SQ1474.2 014900 02 FILLER PIC X(9) VALUE SPACE. SQ1474.2 015000 02 RE-MARK PIC X(61). SQ1474.2 015100 01 TEST-COMPUTED. SQ1474.2 015200 02 FILLER PIC X(30) VALUE SPACE. SQ1474.2 015300 02 FILLER PIC X(17) VALUE " COMPUTED =". SQ1474.2 015400 02 COMPUTED-X. SQ1474.2 015500 03 COMPUTED-A PIC X(20) VALUE SPACE. SQ1474.2 015600 03 COMPUTED-N REDEFINES COMPUTED-A PIC -9(9).9(9). SQ1474.2 015700 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). SQ1474.2 015800 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). SQ1474.2 015900 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). SQ1474.2 016000 03 CM-18V0 REDEFINES COMPUTED-A. SQ1474.2 016100 04 COMPUTED-18V0 PIC -9(18). SQ1474.2 016200 04 FILLER PIC X. SQ1474.2 016300 03 FILLER PIC X(50) VALUE SPACE. SQ1474.2 016400 01 TEST-CORRECT. SQ1474.2 016500 02 FILLER PIC X(30) VALUE SPACE. SQ1474.2 016600 02 FILLER PIC X(17) VALUE " CORRECT =". SQ1474.2 016700 02 CORRECT-X. SQ1474.2 016800 03 CORRECT-A PIC X(20) VALUE SPACE. SQ1474.2 016900 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). SQ1474.2 017000 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). SQ1474.2 017100 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). SQ1474.2 017200 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). SQ1474.2 017300 03 CR-18V0 REDEFINES CORRECT-A. SQ1474.2 017400 04 CORRECT-18V0 PIC -9(18). SQ1474.2 017500 04 FILLER PIC X. SQ1474.2 017600 03 FILLER PIC X(2) VALUE SPACE. SQ1474.2 017700 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. SQ1474.2 017800* SQ1474.2 017900 01 CCVS-C-1. SQ1474.2 018000 02 FILLER PIC IS X VALUE SPACE. SQ1474.2 018100 02 FILLER PIC IS X(17) VALUE "PARAGRAPH-NAME". SQ1474.2 018200 02 FILLER PIC IS X VALUE SPACE. SQ1474.2 018300 02 FILLER PIC IS X(24) VALUE IS "FEATURE". SQ1474.2 018400 02 FILLER PIC IS X VALUE SPACE. SQ1474.2 018500 02 FILLER PIC IS X(5) VALUE "PASS ". SQ1474.2 018600 02 FILLER PIC IS X(9) VALUE SPACE. SQ1474.2 018700 02 FILLER PIC IS X(62) VALUE "REMARKS". SQ1474.2 018800 01 CCVS-C-2. SQ1474.2 018900 02 FILLER PIC X(19) VALUE SPACE. SQ1474.2 019000 02 FILLER PIC X(6) VALUE "TESTED". SQ1474.2 019100 02 FILLER PIC X(19) VALUE SPACE. SQ1474.2 019200 02 FILLER PIC X(4) VALUE "FAIL". SQ1474.2 019300 02 FILLER PIC X(72) VALUE SPACE. SQ1474.2 019400* SQ1474.2 019500 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. SQ1474.2 019600 01 REC-CT PIC 99 VALUE ZERO. SQ1474.2 019700 01 DELETE-COUNTER PIC 999 VALUE ZERO. SQ1474.2 019800 01 ERROR-COUNTER PIC 999 VALUE ZERO. SQ1474.2 019900 01 INSPECT-COUNTER PIC 999 VALUE ZERO. SQ1474.2 020000 01 PASS-COUNTER PIC 999 VALUE ZERO. SQ1474.2 020100 01 TOTAL-ERROR PIC 999 VALUE ZERO. SQ1474.2 020200 01 ERROR-HOLD PIC 999 VALUE ZERO. SQ1474.2 020300 01 DUMMY-HOLD PIC X(120) VALUE SPACE. SQ1474.2 020400 01 RECORD-COUNT PIC 9(5) VALUE ZERO. SQ1474.2 020500 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. SQ1474.2 020600 01 CCVS-H-1. SQ1474.2 020700 02 FILLER PIC X(39) VALUE SPACES. SQ1474.2 020800 02 FILLER PIC X(42) VALUE SQ1474.2 020900 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". SQ1474.2 021000 02 FILLER PIC X(39) VALUE SPACES. SQ1474.2 021100 01 CCVS-H-2A. SQ1474.2 021200 02 FILLER PIC X(40) VALUE SPACE. SQ1474.2 021300 02 FILLER PIC X(7) VALUE "CCVS85 ". SQ1474.2 021400 02 FILLER PIC XXXX VALUE SQ1474.2 021500 "4.2 ". SQ1474.2 021600 02 FILLER PIC X(28) VALUE SQ1474.2 021700 " COPY - NOT FOR DISTRIBUTION". SQ1474.2 021800 02 FILLER PIC X(41) VALUE SPACE. SQ1474.2 021900* SQ1474.2 022000 01 CCVS-H-2B. SQ1474.2 022100 02 FILLER PIC X(15) VALUE "TEST RESULT OF ". SQ1474.2 022200 02 TEST-ID PIC X(9). SQ1474.2 022300 02 FILLER PIC X(4) VALUE " IN ". SQ1474.2 022400 02 FILLER PIC X(12) VALUE SQ1474.2 022500 " HIGH ". SQ1474.2 022600 02 FILLER PIC X(22) VALUE SQ1474.2 022700 " LEVEL VALIDATION FOR ". SQ1474.2 022800 02 FILLER PIC X(58) VALUE SQ1474.2 022900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1474.2 023000 01 CCVS-H-3. SQ1474.2 023100 02 FILLER PIC X(34) VALUE SQ1474.2 023200 " FOR OFFICIAL USE ONLY ". SQ1474.2 023300 02 FILLER PIC X(58) VALUE SQ1474.2 023400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1474.2 023500 02 FILLER PIC X(28) VALUE SQ1474.2 023600 " COPYRIGHT 1985,1986 ". SQ1474.2 023700 01 CCVS-E-1. SQ1474.2 023800 02 FILLER PIC X(52) VALUE SPACE. SQ1474.2 023900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". SQ1474.2 024000 02 ID-AGAIN PIC X(9). SQ1474.2 024100 02 FILLER PIC X(45) VALUE SPACES. SQ1474.2 024200 01 CCVS-E-2. SQ1474.2 024300 02 FILLER PIC X(31) VALUE SPACE. SQ1474.2 024400 02 FILLER PIC X(21) VALUE SPACE. SQ1474.2 024500 02 CCVS-E-2-2. SQ1474.2 024600 03 ERROR-TOTAL PIC XXX VALUE SPACE. SQ1474.2 024700 03 FILLER PIC X VALUE SPACE. SQ1474.2 024800 03 ENDER-DESC PIC X(44) VALUE SQ1474.2 024900 "ERRORS ENCOUNTERED". SQ1474.2 025000 01 CCVS-E-3. SQ1474.2 025100 02 FILLER PIC X(22) VALUE SQ1474.2 025200 " FOR OFFICIAL USE ONLY". SQ1474.2 025300 02 FILLER PIC X(12) VALUE SPACE. SQ1474.2 025400 02 FILLER PIC X(58) VALUE SQ1474.2 025500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1474.2 025600 02 FILLER PIC X(8) VALUE SPACE. SQ1474.2 025700 02 FILLER PIC X(20) VALUE SQ1474.2 025800 " COPYRIGHT 1985,1986". SQ1474.2 025900 01 CCVS-E-4. SQ1474.2 026000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. SQ1474.2 026100 02 FILLER PIC X(4) VALUE " OF ". SQ1474.2 026200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. SQ1474.2 026300 02 FILLER PIC X(40) VALUE SQ1474.2 026400 " TESTS WERE EXECUTED SUCCESSFULLY". SQ1474.2 026500 01 XXINFO. SQ1474.2 026600 02 FILLER PIC X(19) VALUE "*** INFORMATION ***". SQ1474.2 026700 02 INFO-TEXT. SQ1474.2 026800 04 FILLER PIC X(8) VALUE SPACE. SQ1474.2 026900 04 XXCOMPUTED PIC X(20). SQ1474.2 027000 04 FILLER PIC X(5) VALUE SPACE. SQ1474.2 027100 04 XXCORRECT PIC X(20). SQ1474.2 027200 02 INF-ANSI-REFERENCE PIC X(48). SQ1474.2 027300 01 HYPHEN-LINE. SQ1474.2 027400 02 FILLER PIC IS X VALUE IS SPACE. SQ1474.2 027500 02 FILLER PIC IS X(65) VALUE IS "************************SQ1474.2 027600- "*****************************************". SQ1474.2 027700 02 FILLER PIC IS X(54) VALUE IS "************************SQ1474.2 027800- "******************************". SQ1474.2 027900 01 CCVS-PGM-ID PIC X(9) VALUE SQ1474.2 028000 "SQ147A". SQ1474.2 028100* SQ1474.2 028200* SQ1474.2 028300 PROCEDURE DIVISION. SQ1474.2 028400 DECLARATIVES. SQ1474.2 028500 SQ147A-DECLARATIVE-001-SECT SECTION. SQ1474.2 028600 USE AFTER STANDARD ERROR PROCEDURE SQ-FS1. SQ1474.2 028700 SQ-FS1-ERROR-PROCEDURE. SQ1474.2 028800 IF SQ-FS1-STATUS = "47" SQ1474.2 028900 PERFORM DECL-PASS SQ1474.2 029000 GO TO DECL-ABNORMAL-TERM SQ1474.2 029100 ELSE SQ1474.2 029200 MOVE "47" TO CORRECT-A SQ1474.2 029300 MOVE SQ-FS1-STATUS TO COMPUTED-A SQ1474.2 029400 MOVE "STATUS FOR READ OF CLOSED FILE INCORRECT" SQ1474.2 029500 TO RE-MARK SQ1474.2 029600 MOVE "VII-5, 1.3.5(4)F" TO ANSI-REFERENCE SQ1474.2 029700 PERFORM DECL-FAIL SQ1474.2 029800 GO TO DECL-ABNORMAL-TERM SQ1474.2 029900 END-IF. SQ1474.2 030000* SQ1474.2 030100 DECL-PASS. SQ1474.2 030200 MOVE "PASS " TO P-OR-F. SQ1474.2 030300 ADD 1 TO PASS-COUNTER. SQ1474.2 030400 PERFORM DECL-PRINT-DETAIL. SQ1474.2 030500* SQ1474.2 030600 DECL-FAIL. SQ1474.2 030700 MOVE "FAIL*" TO P-OR-F. SQ1474.2 030800 ADD 1 TO ERROR-COUNTER. SQ1474.2 030900 PERFORM DECL-PRINT-DETAIL. SQ1474.2 031000* SQ1474.2 031100 DECL-DE-LETE. SQ1474.2 031200 MOVE "****TEST DELETED****" TO RE-MARK. SQ1474.2 031300 MOVE "*****" TO P-OR-F. SQ1474.2 031400 ADD 1 TO DELETE-COUNTER. SQ1474.2 031500 PERFORM DECL-PRINT-DETAIL. SQ1474.2 031600* SQ1474.2 031700 DECL-PRINT-DETAIL. SQ1474.2 031800 IF REC-CT NOT EQUAL TO ZERO SQ1474.2 031900 MOVE "." TO PARDOT-X SQ1474.2 032000 MOVE REC-CT TO DOTVALUE. SQ1474.2 032100 MOVE TEST-RESULTS TO PRINT-REC. SQ1474.2 032200 PERFORM DECL-WRITE-LINE. SQ1474.2 032300 IF P-OR-F EQUAL TO "FAIL*" SQ1474.2 032400 PERFORM DECL-WRITE-LINE SQ1474.2 032500 PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX SQ1474.2 032600 ELSE SQ1474.2 032700 PERFORM DECL-BAIL THRU DECL-BAIL-EX. SQ1474.2 032800 MOVE SPACE TO P-OR-F. SQ1474.2 032900 MOVE SPACE TO COMPUTED-X. SQ1474.2 033000 MOVE SPACE TO CORRECT-X. SQ1474.2 033100 IF REC-CT EQUAL TO ZERO SQ1474.2 033200 MOVE SPACE TO PAR-NAME. SQ1474.2 033300 MOVE SPACE TO RE-MARK. SQ1474.2 033400* SQ1474.2 033500 DECL-WRITE-LINE. SQ1474.2 033600 ADD 1 TO RECORD-COUNT. SQ1474.2 033700 IF RECORD-COUNT GREATER 50 SQ1474.2 033800 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1474.2 033900 MOVE SPACE TO DUMMY-RECORD SQ1474.2 034000 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1474.2 034100 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN SQ1474.2 034200 MOVE CCVS-C-2 TO DUMMY-RECORD SQ1474.2 034300 PERFORM DECL-WRT-LN 2 TIMES SQ1474.2 034400 MOVE HYPHEN-LINE TO DUMMY-RECORD SQ1474.2 034500 PERFORM DECL-WRT-LN SQ1474.2 034600 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1474.2 034700 MOVE ZERO TO RECORD-COUNT. SQ1474.2 034800 PERFORM DECL-WRT-LN. SQ1474.2 034900* SQ1474.2 035000 DECL-WRT-LN. SQ1474.2 035100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1474.2 035200 MOVE SPACE TO DUMMY-RECORD. SQ1474.2 035300* SQ1474.2 035400 DECL-FAIL-ROUTINE. SQ1474.2 035500 IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1474.2 035600 IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE. SQ1474.2 035700 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1474.2 035800 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1474.2 035900 MOVE XXINFO TO DUMMY-RECORD. SQ1474.2 036000 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1474.2 036100 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1474.2 036200 GO TO DECL-FAIL-EX. SQ1474.2 036300 DECL-FAIL-WRITE. SQ1474.2 036400 MOVE TEST-COMPUTED TO PRINT-REC SQ1474.2 036500 PERFORM DECL-WRITE-LINE SQ1474.2 036600 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1474.2 036700 MOVE TEST-CORRECT TO PRINT-REC SQ1474.2 036800 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1474.2 036900 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1474.2 037000 DECL-FAIL-EX. SQ1474.2 037100 EXIT. SQ1474.2 037200* SQ1474.2 037300 DECL-BAIL. SQ1474.2 037400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE. SQ1474.2 037500 IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX. SQ1474.2 037600 DECL-BAIL-WRITE. SQ1474.2 037700 MOVE CORRECT-A TO XXCORRECT. SQ1474.2 037800 MOVE COMPUTED-A TO XXCOMPUTED. SQ1474.2 037900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1474.2 038000 MOVE XXINFO TO DUMMY-RECORD. SQ1474.2 038100 PERFORM DECL-WRITE-LINE 2 TIMES. SQ1474.2 038200 MOVE SPACE TO INF-ANSI-REFERENCE. SQ1474.2 038300 DECL-BAIL-EX. SQ1474.2 038400 EXIT. SQ1474.2 038500* SQ1474.2 038600 DECL-ABNORMAL-TERM. SQ1474.2 038700 MOVE SPACE TO DUMMY-RECORD. SQ1474.2 038800 PERFORM DECL-WRITE-LINE. SQ1474.2 038900 MOVE "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE" SQ1474.2 039000 TO DUMMY-RECORD. SQ1474.2 039100 PERFORM DECL-WRITE-LINE 3 TIMES. SQ1474.2 039200* SQ1474.2 039300 END-DECLS. SQ1474.2 039400 EXIT. SQ1474.2 039500 END DECLARATIVES. SQ1474.2 039600* SQ1474.2 039700* SQ1474.2 039800 CCVS1 SECTION. SQ1474.2 039900 OPEN-FILES. SQ1474.2 040000 OPEN OUTPUT PRINT-FILE. SQ1474.2 040100 MOVE CCVS-PGM-ID TO TEST-ID. SQ1474.2 040200 MOVE CCVS-PGM-ID TO ID-AGAIN. SQ1474.2 040300 MOVE SPACE TO TEST-RESULTS. SQ1474.2 040400 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. SQ1474.2 040500 MOVE ZERO TO REC-SKEL-SUB. SQ1474.2 040600 PERFORM CCVS-INIT-FILE 10 TIMES. SQ1474.2 040700 GO TO CCVS1-EXIT. SQ1474.2 040800* SQ1474.2 040900 CCVS-INIT-FILE. SQ1474.2 041000 ADD 1 TO REC-SKL-SUB. SQ1474.2 041100 MOVE FILE-RECORD-INFO-SKELETON TO SQ1474.2 041200 FILE-RECORD-INFO (REC-SKL-SUB). SQ1474.2 041300* SQ1474.2 041400 CLOSE-FILES. SQ1474.2 041500 PERFORM END-ROUTINE THRU END-ROUTINE-13. SQ1474.2 041600 CLOSE PRINT-FILE. SQ1474.2 041700 TERMINATE-CCVS. SQ1474.2 041800 STOP RUN. SQ1474.2 041900* SQ1474.2 042000 INSPT. SQ1474.2 042100 MOVE "INSPT" TO P-OR-F. SQ1474.2 042200 ADD 1 TO INSPECT-COUNTER. SQ1474.2 042300 PERFORM PRINT-DETAIL. SQ1474.2 042400 SQ1474.2 042500 PASS. SQ1474.2 042600 MOVE "PASS " TO P-OR-F. SQ1474.2 042700 ADD 1 TO PASS-COUNTER. SQ1474.2 042800 PERFORM PRINT-DETAIL. SQ1474.2 042900* SQ1474.2 043000 FAIL. SQ1474.2 043100 MOVE "FAIL*" TO P-OR-F. SQ1474.2 043200 ADD 1 TO ERROR-COUNTER. SQ1474.2 043300 PERFORM PRINT-DETAIL. SQ1474.2 043400* SQ1474.2 043500 DE-LETE. SQ1474.2 043600 MOVE "****TEST DELETED****" TO RE-MARK. SQ1474.2 043700 MOVE "*****" TO P-OR-F. SQ1474.2 043800 ADD 1 TO DELETE-COUNTER. SQ1474.2 043900 PERFORM PRINT-DETAIL. SQ1474.2 044000* SQ1474.2 044100 PRINT-DETAIL. SQ1474.2 044200 IF REC-CT NOT EQUAL TO ZERO SQ1474.2 044300 MOVE "." TO PARDOT-X SQ1474.2 044400 MOVE REC-CT TO DOTVALUE. SQ1474.2 044500 MOVE TEST-RESULTS TO PRINT-REC. SQ1474.2 044600 PERFORM WRITE-LINE. SQ1474.2 044700 IF P-OR-F EQUAL TO "FAIL*" SQ1474.2 044800 PERFORM WRITE-LINE SQ1474.2 044900 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX SQ1474.2 045000 ELSE SQ1474.2 045100 PERFORM BAIL-OUT THRU BAIL-OUT-EX. SQ1474.2 045200 MOVE SPACE TO P-OR-F. SQ1474.2 045300 MOVE SPACE TO COMPUTED-X. SQ1474.2 045400 MOVE SPACE TO CORRECT-X. SQ1474.2 045500 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. SQ1474.2 045600 MOVE SPACE TO RE-MARK. SQ1474.2 045700* SQ1474.2 045800 HEAD-ROUTINE. SQ1474.2 045900 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1474.2 046000 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1474.2 046100 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1474.2 046200 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. SQ1474.2 046300 COLUMN-NAMES-ROUTINE. SQ1474.2 046400 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1474.2 046500 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. SQ1474.2 046600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1474.2 046700 END-ROUTINE. SQ1474.2 046800 MOVE HYPHEN-LINE TO DUMMY-RECORD. SQ1474.2 046900 PERFORM WRITE-LINE 5 TIMES. SQ1474.2 047000 END-RTN-EXIT. SQ1474.2 047100 MOVE CCVS-E-1 TO DUMMY-RECORD. SQ1474.2 047200 PERFORM WRITE-LINE 2 TIMES. SQ1474.2 047300* SQ1474.2 047400 END-ROUTINE-1. SQ1474.2 047500 ADD ERROR-COUNTER TO ERROR-HOLD SQ1474.2 047600 ADD INSPECT-COUNTER TO ERROR-HOLD. SQ1474.2 047700 ADD DELETE-COUNTER TO ERROR-HOLD. SQ1474.2 047800 ADD PASS-COUNTER TO ERROR-HOLD. SQ1474.2 047900 MOVE PASS-COUNTER TO CCVS-E-4-1. SQ1474.2 048000 MOVE ERROR-HOLD TO CCVS-E-4-2. SQ1474.2 048100 MOVE CCVS-E-4 TO CCVS-E-2-2. SQ1474.2 048200 MOVE CCVS-E-2 TO DUMMY-RECORD SQ1474.2 048300 PERFORM WRITE-LINE. SQ1474.2 048400 MOVE "TEST(S) FAILED" TO ENDER-DESC. SQ1474.2 048500 IF ERROR-COUNTER IS EQUAL TO ZERO SQ1474.2 048600 MOVE "NO " TO ERROR-TOTAL SQ1474.2 048700 ELSE SQ1474.2 048800 MOVE ERROR-COUNTER TO ERROR-TOTAL. SQ1474.2 048900 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1474.2 049000 PERFORM WRITE-LINE. SQ1474.2 049100 END-ROUTINE-13. SQ1474.2 049200 IF DELETE-COUNTER IS EQUAL TO ZERO SQ1474.2 049300 MOVE "NO " TO ERROR-TOTAL SQ1474.2 049400 ELSE SQ1474.2 049500 MOVE DELETE-COUNTER TO ERROR-TOTAL. SQ1474.2 049600 MOVE "TEST(S) DELETED " TO ENDER-DESC. SQ1474.2 049700 MOVE CCVS-E-2 TO DUMMY-RECORD. SQ1474.2 049800 PERFORM WRITE-LINE. SQ1474.2 049900 IF INSPECT-COUNTER EQUAL TO ZERO SQ1474.2 050000 MOVE "NO " TO ERROR-TOTAL SQ1474.2 050100 ELSE SQ1474.2 050200 MOVE INSPECT-COUNTER TO ERROR-TOTAL. SQ1474.2 050300 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. SQ1474.2 050400 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1474.2 050500 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. SQ1474.2 050600* SQ1474.2 050700 WRITE-LINE. SQ1474.2 050800 ADD 1 TO RECORD-COUNT. SQ1474.2 050900 IF RECORD-COUNT GREATER 50 SQ1474.2 051000 MOVE DUMMY-RECORD TO DUMMY-HOLD SQ1474.2 051100 MOVE SPACE TO DUMMY-RECORD SQ1474.2 051200 WRITE DUMMY-RECORD AFTER ADVANCING PAGE SQ1474.2 051300 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN SQ1474.2 051400 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES SQ1474.2 051500 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN SQ1474.2 051600 MOVE DUMMY-HOLD TO DUMMY-RECORD SQ1474.2 051700 MOVE ZERO TO RECORD-COUNT. SQ1474.2 051800 PERFORM WRT-LN. SQ1474.2 051900* SQ1474.2 052000 WRT-LN. SQ1474.2 052100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. SQ1474.2 052200 MOVE SPACE TO DUMMY-RECORD. SQ1474.2 052300 BLANK-LINE-PRINT. SQ1474.2 052400 PERFORM WRT-LN. SQ1474.2 052500 FAIL-ROUTINE. SQ1474.2 052600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1474.2 052700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. SQ1474.2 052800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1474.2 052900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. SQ1474.2 053000 MOVE XXINFO TO DUMMY-RECORD. SQ1474.2 053100 PERFORM WRITE-LINE 2 TIMES. SQ1474.2 053200 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1474.2 053300 GO TO FAIL-ROUTINE-EX. SQ1474.2 053400 FAIL-ROUTINE-WRITE. SQ1474.2 053500 MOVE TEST-COMPUTED TO PRINT-REC SQ1474.2 053600 PERFORM WRITE-LINE SQ1474.2 053700 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. SQ1474.2 053800 MOVE TEST-CORRECT TO PRINT-REC SQ1474.2 053900 PERFORM WRITE-LINE 2 TIMES. SQ1474.2 054000 MOVE SPACES TO COR-ANSI-REFERENCE. SQ1474.2 054100 FAIL-ROUTINE-EX. SQ1474.2 054200 EXIT. SQ1474.2 054300 BAIL-OUT. SQ1474.2 054400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. SQ1474.2 054500 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. SQ1474.2 054600 BAIL-OUT-WRITE. SQ1474.2 054700 MOVE CORRECT-A TO XXCORRECT. SQ1474.2 054800 MOVE COMPUTED-A TO XXCOMPUTED. SQ1474.2 054900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. SQ1474.2 055000 MOVE XXINFO TO DUMMY-RECORD. SQ1474.2 055100 PERFORM WRITE-LINE 2 TIMES. SQ1474.2 055200 MOVE SPACES TO INF-ANSI-REFERENCE. SQ1474.2 055300 BAIL-OUT-EX. SQ1474.2 055400 EXIT. SQ1474.2 055500 CCVS1-EXIT. SQ1474.2 055600 EXIT. SQ1474.2 055700* SQ1474.2 055800**************************************************************** SQ1474.2 055900* * SQ1474.2 056000* THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND * SQ1474.2 056100* THE START OF THE TESTS OF SPECIFIC COBOL FEATURES. * SQ1474.2 056200* * SQ1474.2 056300**************************************************************** SQ1474.2 056400* SQ1474.2 056500 SECT-SQ147A-0001 SECTION. SQ1474.2 056600 WRITE-INIT-FG-01. SQ1474.2 056700* SQ1474.2 056800* THIS TEST CREATES FILE SQ-FS1 AND CLOSES IT. SQ1474.2 056900* FIRST IT SETS UP A SKELETON RECORD IN WORKING STORAGE. SQ1474.2 057000* SQ1474.2 057100 MOVE "SQ-FS1" TO XFILE-NAME (1). SQ1474.2 057200 MOVE "R1-F-G" TO XRECORD-NAME (1). SQ1474.2 057300 MOVE CCVS-PGM-ID TO XPROGRAM-NAME (1). SQ1474.2 057400 MOVE 120 TO XRECORD-LENGTH (1). SQ1474.2 057500 MOVE "RC" TO CHARS-OR-RECORDS (1). SQ1474.2 057600 MOVE 1 TO XBLOCK-SIZE (1). SQ1474.2 057700 MOVE 1 TO RECORDS-IN-FILE (1). SQ1474.2 057800 MOVE "SQ" TO XFILE-ORGANIZATION (1). SQ1474.2 057900 MOVE "S" TO XLABEL-TYPE (1). SQ1474.2 058000 MOVE 1 TO XRECORD-NUMBER (1). SQ1474.2 058100* SQ1474.2 058200 WRITE-OPEN-01. SQ1474.2 058300 OPEN OUTPUT SQ-FS1. SQ1474.2 058400* SQ1474.2 058500* WRITE A SINGLE RECORD TO THE FILE SQ1474.2 058600* SQ1474.2 058700 WRITE-INIT-01. SQ1474.2 058800 WRITE-TEST-01-01. SQ1474.2 058900 MOVE FILE-RECORD-INFO-P1-120 (1) TO SQ-FS1R1-F-G-120. SQ1474.2 059000 WRITE SQ-FS1R1-F-G-120. SQ1474.2 059100* SQ1474.2 059200* CLOSE THE FILE. SQ1474.2 059300* SQ1474.2 059400 CLOSE-INIT-01. SQ1474.2 059500 CLOSE-TEST-01. SQ1474.2 059600 CLOSE SQ-FS1. SQ1474.2 059700* SQ1474.2 059800 READ-INIT-01. SQ1474.2 059900* SQ1474.2 060000* WE WILL NOW ATTEMPT TO READ A RECORD FROM THE SQ1474.2 060100* CLOSED FILE. I-O STATUS 47 SHOULD BE GENERATED. SQ1474.2 060200* SQ1474.2 060300 MOVE "READ CLOSED FILE" TO FEATURE. SQ1474.2 060400 MOVE "**" TO SQ-FS1-STATUS. SQ1474.2 060500 MOVE "READ-TEST-01" TO PAR-NAME. SQ1474.2 060600 MOVE 1 TO REC-CT. SQ1474.2 060700* SQ1474.2 060800 READ-TEST-01. SQ1474.2 060900 READ SQ-FS1. SQ1474.2 061000* SQ1474.2 061100 CCVS-EXIT SECTION. SQ1474.2 061200 CCVS-999999. SQ1474.2 061300 GO TO CLOSE-FILES. SQ1474.2 ¤ Diese beiden folgenden Angebotsgruppen bietet das Unternehmen0.31Angebot Wie Sie bei der Firma Beratungs- und Dienstleistungen beauftragen können ¤*Bot Zugriff |
|
2026-03-28