| products/sources/formale Sprachen/Cobol/Test-Suite/COBOL/ST/ |
|
Quellcode-Bibliothek© Kompilation durch diese Firma[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]Datei: ic117m.cob Sprache: Cobol |
|
||||||
|
000100 IDENTIFICATION DIVISION. IC2334.2
000200 PROGRAM-ID. IC2334.2 000300 IC233A. IC2334.2 000400**************************************************************** IC2334.2 000500* * IC2334.2 000600* VALIDATION FOR:- * IC2334.2 000700* * IC2334.2 000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2334.2 000900* * IC2334.2 001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2334.2 001100* * IC2334.2 001200**************************************************************** IC2334.2 001300* * IC2334.2 001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2334.2 001500* * IC2334.2 001600* X-55 - SYSTEM PRINTER NAME. * IC2334.2 001700* X-82 - SOURCE COMPUTER NAME. * IC2334.2 001800* X-83 - OBJECT COMPUTER NAME. * IC2334.2 001900* X-18 - OPTIONAL SEQUENTIAL MASS STORAGE FILE. * IC2334.2 002000**************************************************************** IC2334.2 002100* * IC2334.2 002200* PROGRAMS IC233A AND IC233A-1 TEST THAT A "USE" PROCEDURE * IC2334.2 002300* IN A CALLING PROGRAM IS INVOKED BY A QUALIFYING CONDITION * IC2334.2 002400* OCCURRING IN A CONTAINED PROGRAM. * IC2334.2 002500* * IC2334.2 002600* BOTH PROGRAMS WILL BE COMPILED IN ONE INVOCATION OF THE * IC2334.2 002700* COMPILER AS SHOWN BELOW: * IC2334.2 002800* IDENTIFICATION DIVISION. * IC2334.2 002900* PROGRAM-ID. IC233A. * IC2334.2 003000* . * IC2334.2 003100* . * IC2334.2 003200* . * IC2334.2 003300* IDENTIFICATION DIVISION. * IC2334.2 003400* PROGRAM-ID. IC233A-1. * IC2334.2 003500* . * IC2334.2 003600* . * IC2334.2 003700* END PROGRAM IC233A-1. * IC2334.2 003800* END PROGRAM IC233A. * IC2334.2 003900**************************************************************** IC2334.2 004000 ENVIRONMENT DIVISION. IC2334.2 004100 CONFIGURATION SECTION. IC2334.2 004200 SOURCE-COMPUTER. IC2334.2 004300 Card0130. IC2334.2 004400 OBJECT-COMPUTER. IC2334.2 004500 Card0131. IC2334.2 004600 INPUT-OUTPUT SECTION. IC2334.2 004700 FILE-CONTROL. IC2334.2 004800 SELECT PRINT-FILE ASSIGN TO IC2334.2 004900 "C0085" . IC2334.2 005000 SELECT OPTIONAL TEST-FILE ASSIGN TO IC2334.2 005100 "C0024" . IC2334.2 005200 DATA DIVISION. IC2334.2 005300 FILE SECTION. IC2334.2 005400 FD PRINT-FILE. IC2334.2 005500 01 PRINT-REC PICTURE X(120). IC2334.2 005600 01 DUMMY-RECORD PICTURE X(120). IC2334.2 005700 FD TEST-FILE GLOBAL. IC2334.2 005800 01 TEST-REC PIC X(20). IC2334.2 005900 WORKING-STORAGE SECTION. IC2334.2 006000 01 DILFRAP PIC 9. IC2334.2 006100 01 TEST-RESULTS. IC2334.2 006200 02 FILLER PIC X VALUE SPACE. IC2334.2 006300 02 FEATURE PIC X(20) VALUE SPACE. IC2334.2 006400 02 FILLER PIC X VALUE SPACE. IC2334.2 006500 02 P-OR-F PIC X(5) VALUE SPACE. IC2334.2 006600 02 FILLER PIC X VALUE SPACE. IC2334.2 006700 02 PAR-NAME. IC2334.2 006800 03 FILLER PIC X(19) VALUE SPACE. IC2334.2 006900 03 PARDOT-X PIC X VALUE SPACE. IC2334.2 007000 03 DOTVALUE PIC 99 VALUE ZERO. IC2334.2 007100 02 FILLER PIC X(8) VALUE SPACE. IC2334.2 007200 02 RE-MARK PIC X(61). IC2334.2 007300 01 TEST-COMPUTED. IC2334.2 007400 02 FILLER PIC X(30) VALUE SPACE. IC2334.2 007500 02 FILLER PIC X(17) VALUE IC2334.2 007600 " COMPUTED=". IC2334.2 007700 02 COMPUTED-X. IC2334.2 007800 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2334.2 007900 03 COMPUTED-N REDEFINES COMPUTED-A IC2334.2 008000 PIC -9(9).9(9). IC2334.2 008100 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2334.2 008200 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2334.2 008300 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2334.2 008400 03 CM-18V0 REDEFINES COMPUTED-A. IC2334.2 008500 04 COMPUTED-18V0 PIC -9(18). IC2334.2 008600 04 FILLER PIC X. IC2334.2 008700 03 FILLER PIC X(50) VALUE SPACE. IC2334.2 008800 01 TEST-CORRECT. IC2334.2 008900 02 FILLER PIC X(30) VALUE SPACE. IC2334.2 009000 02 FILLER PIC X(17) VALUE " CORRECT =". IC2334.2 009100 02 CORRECT-X. IC2334.2 009200 03 CORRECT-A PIC X(20) VALUE SPACE. IC2334.2 009300 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2334.2 009400 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2334.2 009500 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2334.2 009600 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2334.2 009700 03 CR-18V0 REDEFINES CORRECT-A. IC2334.2 009800 04 CORRECT-18V0 PIC -9(18). IC2334.2 009900 04 FILLER PIC X. IC2334.2 010000 03 FILLER PIC X(2) VALUE SPACE. IC2334.2 010100 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2334.2 010200 01 CCVS-C-1. IC2334.2 010300 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2334.2 010400- "SS PARAGRAPH-NAME IC2334.2 010500- " REMARKS". IC2334.2 010600 02 FILLER PIC X(20) VALUE SPACE. IC2334.2 010700 01 CCVS-C-2. IC2334.2 010800 02 FILLER PIC X VALUE SPACE. IC2334.2 010900 02 FILLER PIC X(6) VALUE "TESTED". IC2334.2 011000 02 FILLER PIC X(15) VALUE SPACE. IC2334.2 011100 02 FILLER PIC X(4) VALUE "FAIL". IC2334.2 011200 02 FILLER PIC X(94) VALUE SPACE. IC2334.2 011300 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2334.2 011400 01 REC-CT PIC 99 VALUE ZERO. IC2334.2 011500 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2334.2 011600 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2334.2 011700 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2334.2 011800 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2334.2 011900 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2334.2 012000 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2334.2 012100 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2334.2 012200 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2334.2 012300 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2334.2 012400 01 CCVS-H-1. IC2334.2 012500 02 FILLER PIC X(39) VALUE SPACES. IC2334.2 012600 02 FILLER PIC X(42) VALUE IC2334.2 012700 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2334.2 012800 02 FILLER PIC X(39) VALUE SPACES. IC2334.2 012900 01 CCVS-H-2A. IC2334.2 013000 02 FILLER PIC X(40) VALUE SPACE. IC2334.2 013100 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2334.2 013200 02 FILLER PIC XXXX VALUE IC2334.2 013300 "4.2 ". IC2334.2 013400 02 FILLER PIC X(28) VALUE IC2334.2 013500 " COPY - NOT FOR DISTRIBUTION". IC2334.2 013600 02 FILLER PIC X(41) VALUE SPACE. IC2334.2 013700 IC2334.2 013800 01 CCVS-H-2B. IC2334.2 013900 02 FILLER PIC X(15) VALUE IC2334.2 014000 "TEST RESULT OF ". IC2334.2 014100 02 TEST-ID PIC X(9). IC2334.2 014200 02 FILLER PIC X(4) VALUE IC2334.2 014300 " IN ". IC2334.2 014400 02 FILLER PIC X(12) VALUE IC2334.2 014500 " HIGH ". IC2334.2 014600 02 FILLER PIC X(22) VALUE IC2334.2 014700 " LEVEL VALIDATION FOR ". IC2334.2 014800 02 FILLER PIC X(58) VALUE IC2334.2 014900 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2334.2 015000 01 CCVS-H-3. IC2334.2 015100 02 FILLER PIC X(34) VALUE IC2334.2 015200 " FOR OFFICIAL USE ONLY ". IC2334.2 015300 02 FILLER PIC X(58) VALUE IC2334.2 015400 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2334.2 015500 02 FILLER PIC X(28) VALUE IC2334.2 015600 " COPYRIGHT 1985 ". IC2334.2 015700 01 CCVS-E-1. IC2334.2 015800 02 FILLER PIC X(52) VALUE SPACE. IC2334.2 015900 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2334.2 016000 02 ID-AGAIN PIC X(9). IC2334.2 016100 02 FILLER PIC X(45) VALUE SPACES. IC2334.2 016200 01 CCVS-E-2. IC2334.2 016300 02 FILLER PIC X(31) VALUE SPACE. IC2334.2 016400 02 FILLER PIC X(21) VALUE SPACE. IC2334.2 016500 02 CCVS-E-2-2. IC2334.2 016600 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2334.2 016700 03 FILLER PIC X VALUE SPACE. IC2334.2 016800 03 ENDER-DESC PIC X(44) VALUE IC2334.2 016900 "ERRORS ENCOUNTERED". IC2334.2 017000 01 CCVS-E-3. IC2334.2 017100 02 FILLER PIC X(22) VALUE IC2334.2 017200 " FOR OFFICIAL USE ONLY". IC2334.2 017300 02 FILLER PIC X(12) VALUE SPACE. IC2334.2 017400 02 FILLER PIC X(58) VALUE IC2334.2 017500 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2334.2 017600 02 FILLER PIC X(13) VALUE SPACE. IC2334.2 017700 02 FILLER PIC X(15) VALUE IC2334.2 017800 " COPYRIGHT 1985". IC2334.2 017900 01 CCVS-E-4. IC2334.2 018000 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2334.2 018100 02 FILLER PIC X(4) VALUE " OF ". IC2334.2 018200 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2334.2 018300 02 FILLER PIC X(40) VALUE IC2334.2 018400 " TESTS WERE EXECUTED SUCCESSFULLY". IC2334.2 018500 01 XXINFO. IC2334.2 018600 02 FILLER PIC X(19) VALUE IC2334.2 018700 "*** INFORMATION ***". IC2334.2 018800 02 INFO-TEXT. IC2334.2 018900 04 FILLER PIC X(8) VALUE SPACE. IC2334.2 019000 04 XXCOMPUTED PIC X(20). IC2334.2 019100 04 FILLER PIC X(5) VALUE SPACE. IC2334.2 019200 04 XXCORRECT PIC X(20). IC2334.2 019300 02 INF-ANSI-REFERENCE PIC X(48). IC2334.2 019400 01 HYPHEN-LINE. IC2334.2 019500 02 FILLER PIC IS X VALUE IS SPACE. IC2334.2 019600 02 FILLER PIC IS X(65) VALUE IS "************************IC2334.2 019700- "*****************************************". IC2334.2 019800 02 FILLER PIC IS X(54) VALUE IS "************************IC2334.2 019900- "******************************". IC2334.2 020000 01 CCVS-PGM-ID PIC X(9) VALUE IC2334.2 020100 "IC233A". IC2334.2 020200 PROCEDURE DIVISION. IC2334.2 020300 DECLARATIVES. IC2334.2 020400 SECT-IC233A-001 SECTION. IC2334.2 020500 USE GLOBAL AFTER ERROR PROCEDURE ON INPUT. IC2334.2 020600 USE-TEST-2. IC2334.2 020700 PERFORM D1-PASS. IC2334.2 020800 PERFORM D1-PRINT-DETAIL. IC2334.2 020900 MOVE 1 TO DILFRAP. IC2334.2 021000 GO TO EXIT-USE-TEST-2. IC2334.2 021100 D1-PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2334.2 021200 D1-PRINT-DETAIL. IC2334.2 021300 IF REC-CT NOT EQUAL TO ZERO IC2334.2 021400 MOVE "." TO PARDOT-X IC2334.2 021500 MOVE REC-CT TO DOTVALUE. IC2334.2 021600 MOVE TEST-RESULTS TO PRINT-REC. PERFORM D1-WRITE-LINE. IC2334.2 021700 IF P-OR-F EQUAL TO "FAIL*" PERFORM D1-WRITE-LINE IC2334.2 021800 PERFORM D1-FAIL-ROUTINE THRU D1-FAIL-ROUTINE-EX IC2334.2 021900 ELSE PERFORM D1-BAIL-OUT THRU D1-BAIL-OUT-EX. IC2334.2 022000 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2334.2 022100 MOVE SPACE TO CORRECT-X. IC2334.2 022200 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2334.2 022300 MOVE SPACE TO RE-MARK. IC2334.2 022400 D1-WRITE-LINE. IC2334.2 022500 ADD 1 TO RECORD-COUNT. IC2334.2 022600 IF RECORD-COUNT GREATER 50 IC2334.2 022700 MOVE DUMMY-RECORD TO DUMMY-HOLD IC2334.2 022800 MOVE SPACE TO DUMMY-RECORD IC2334.2 022900 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2334.2 023000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM D1-WRT-LN IC2334.2 023100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM D1-WRT-LN 2 TIMES IC2334.2 023200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM D1-WRT-LN IC2334.2 023300 MOVE DUMMY-HOLD TO DUMMY-RECORD IC2334.2 023400 MOVE ZERO TO RECORD-COUNT. IC2334.2 023500 PERFORM D1-WRT-LN. IC2334.2 023600 D1-WRT-LN. IC2334.2 023700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2334.2 023800 MOVE SPACE TO DUMMY-RECORD. IC2334.2 023900 D1-FAIL-ROUTINE. IC2334.2 024000 IF COMPUTED-X NOT EQUAL TO SPACE GO TO D1-FAIL-ROUTINE-WRITE.IC2334.2 024100 IF CORRECT-X NOT EQUAL TO SPACE GO TO D1-FAIL-ROUTINE-WRITE. IC2334.2 024200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2334.2 024300 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2334.2 024400 MOVE XXINFO TO DUMMY-RECORD. PERFORM D1-WRITE-LINE 2 TIMES.IC2334.2 024500 MOVE SPACES TO INF-ANSI-REFERENCE. IC2334.2 024600 GO TO D1-FAIL-ROUTINE-EX. IC2334.2 024700 D1-FAIL-ROUTINE-WRITE. IC2334.2 024800 MOVE TEST-COMPUTED TO PRINT-REC PERFORM D1-WRITE-LINE IC2334.2 024900 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2334.2 025000 MOVE TEST-CORRECT TO PRINT-REC PERFORM D1-WRITE-LINE 2 TIMES.IC2334.2 025100 MOVE SPACES TO COR-ANSI-REFERENCE. IC2334.2 025200 D1-FAIL-ROUTINE-EX. EXIT. IC2334.2 025300 D1-BAIL-OUT. IC2334.2 025400 IF COMPUTED-A NOT EQUAL TO SPACE GO TO D1-BAIL-OUT-WRITE. IC2334.2 025500 IF CORRECT-A EQUAL TO SPACE GO TO D1-BAIL-OUT-EX. IC2334.2 025600 D1-BAIL-OUT-WRITE. IC2334.2 025700 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2334.2 025800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2334.2 025900 MOVE XXINFO TO DUMMY-RECORD. IC2334.2 026000 PERFORM D1-WRITE-LINE 2 TIMES. IC2334.2 026100 MOVE SPACES TO INF-ANSI-REFERENCE. IC2334.2 026200 D1-BAIL-OUT-EX. EXIT. IC2334.2 026300 EXIT-USE-TEST-2. IC2334.2 026400 EXIT. IC2334.2 026500 END DECLARATIVES. IC2334.2 026600 CCVS1 SECTION. IC2334.2 026700 OPEN-FILES. IC2334.2 026800 OPEN OUTPUT PRINT-FILE. IC2334.2 026900 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2334.2 027000 MOVE SPACE TO TEST-RESULTS. IC2334.2 027100 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2334.2 027200 GO TO CCVS1-EXIT. IC2334.2 027300 CLOSE-FILES. IC2334.2 027400 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2334.2 027500 TERMINATE-CCVS. IC2334.2 027600 EXIT PROGRAM. IC2334.2 027700 TERMINATE-CALL. IC2334.2 027800 STOP RUN. IC2334.2 027900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2334.2 028000 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2334.2 028100 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2334.2 028200 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2334.2 028300 MOVE "****TEST DELETED****" TO RE-MARK. IC2334.2 028400 PRINT-DETAIL. IC2334.2 028500 IF REC-CT NOT EQUAL TO ZERO IC2334.2 028600 MOVE "." TO PARDOT-X IC2334.2 028700 MOVE REC-CT TO DOTVALUE. IC2334.2 028800 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2334.2 028900 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2334.2 029000 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2334.2 029100 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2334.2 029200 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2334.2 029300 MOVE SPACE TO CORRECT-X. IC2334.2 029400 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2334.2 029500 MOVE SPACE TO RE-MARK. IC2334.2 029600 HEAD-ROUTINE. IC2334.2 029700 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2334.2 029800 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2334.2 029900 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2334.2 030000 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2334.2 030100 COLUMN-NAMES-ROUTINE. IC2334.2 030200 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2334.2 030300 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2334.2 030400 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2334.2 030500 END-ROUTINE. IC2334.2 030600 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2334.2 030700 END-RTN-EXIT. IC2334.2 030800 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2334.2 030900 END-ROUTINE-1. IC2334.2 031000 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2334.2 031100 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2334.2 031200 ADD PASS-COUNTER TO ERROR-HOLD. IC2334.2 031300* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2334.2 031400 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2334.2 031500 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2334.2 031600 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2334.2 031700 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2334.2 031800 END-ROUTINE-12. IC2334.2 031900 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2334.2 032000 IF ERROR-COUNTER IS EQUAL TO ZERO IC2334.2 032100 MOVE "NO " TO ERROR-TOTAL IC2334.2 032200 ELSE IC2334.2 032300 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2334.2 032400 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2334.2 032500 PERFORM WRITE-LINE. IC2334.2 032600 END-ROUTINE-13. IC2334.2 032700 IF DELETE-COUNTER IS EQUAL TO ZERO IC2334.2 032800 MOVE "NO " TO ERROR-TOTAL ELSE IC2334.2 032900 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2334.2 033000 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2334.2 033100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2334.2 033200 IF INSPECT-COUNTER EQUAL TO ZERO IC2334.2 033300 MOVE "NO " TO ERROR-TOTAL IC2334.2 033400 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2334.2 033500 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2334.2 033600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2334.2 033700 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2334.2 033800 WRITE-LINE. IC2334.2 033900 ADD 1 TO RECORD-COUNT. IC2334.2 034000 IF RECORD-COUNT GREATER 50 IC2334.2 034100 MOVE DUMMY-RECORD TO DUMMY-HOLD IC2334.2 034200 MOVE SPACE TO DUMMY-RECORD IC2334.2 034300 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2334.2 034400 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2334.2 034500 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2334.2 034600 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2334.2 034700 MOVE DUMMY-HOLD TO DUMMY-RECORD IC2334.2 034800 MOVE ZERO TO RECORD-COUNT. IC2334.2 034900 PERFORM WRT-LN. IC2334.2 035000 WRT-LN. IC2334.2 035100 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2334.2 035200 MOVE SPACE TO DUMMY-RECORD. IC2334.2 035300 BLANK-LINE-PRINT. IC2334.2 035400 PERFORM WRT-LN. IC2334.2 035500 FAIL-ROUTINE. IC2334.2 035600 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2334.2 035700 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2334.2 035800 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2334.2 035900 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2334.2 036000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2334.2 036100 MOVE SPACES TO INF-ANSI-REFERENCE. IC2334.2 036200 GO TO FAIL-ROUTINE-EX. IC2334.2 036300 FAIL-ROUTINE-WRITE. IC2334.2 036400 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2334.2 036500 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2334.2 036600 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2334.2 036700 MOVE SPACES TO COR-ANSI-REFERENCE. IC2334.2 036800 FAIL-ROUTINE-EX. EXIT. IC2334.2 036900 BAIL-OUT. IC2334.2 037000 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2334.2 037100 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2334.2 037200 BAIL-OUT-WRITE. IC2334.2 037300 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2334.2 037400 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2334.2 037500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2334.2 037600 MOVE SPACES TO INF-ANSI-REFERENCE. IC2334.2 037700 BAIL-OUT-EX. EXIT. IC2334.2 037800 CCVS1-EXIT. IC2334.2 037900 EXIT. IC2334.2 038000 SECT-IC233A-1R-001 SECTION. IC2334.2 038100 USE-INIT-1. IC2334.2 038200 MOVE "USE-TEST-1" TO PAR-NAME. IC2334.2 038300 MOVE "X-34 5.5.4 GR(1)B" TO ANSI-REFERENCE. IC2334.2 038400 MOVE ZERO TO DILFRAP. IC2334.2 038500 USE-TEST-0. IC2334.2 038600 CALL "IC233A-1". IC2334.2 038700 IF DILFRAP = 1 IC2334.2 038800 GO TO CCVS-EXIT. IC2334.2 038900 USE-FAIL-1. IC2334.2 039000 MOVE "USE PROCEDURE NOT INVOKED" TO RE-MARK. IC2334.2 039100 PERFORM FAIL. IC2334.2 039200 GO TO USE-WRITE-1. IC2334.2 039300 USE-DELETE-1. IC2334.2 039400 PERFORM DE-LETE. IC2334.2 039500 USE-WRITE-1. IC2334.2 039600 PERFORM PRINT-DETAIL. IC2334.2 039700* IC2334.2 039800 CCVS-EXIT SECTION. IC2334.2 039900 CCVS-999999. IC2334.2 040000 GO TO CLOSE-FILES. IC2334.2 040100* IC2334.2 040200 IDENTIFICATION DIVISION. IC2334.2 040300 PROGRAM-ID. IC2334.2 040400 IC233A-1. IC2334.2 040500**************************************************************** IC2334.2 040600* * IC2334.2 040700* THIS PROGRAM FORMS PART OF THE COBOL COMPILER VALIDATION * IC2334.2 040800* SYSTEM (CCVS) USED TO TEST COBOL COMPILERS FOR * IC2334.2 040900* CONFORMANCE WITH THE AMERICAN NATIONAL STANDARD * IC2334.2 041000* (ANSI DOCUMENT REFERENCE: X3.23-1985) AND THE STANDARD OF * IC2334.2 041100* THE INTERNATIONAL ORGANIZATION FOR STANDARDISATION * IC2334.2 041200* (ISO DOCUMENT REFERENCE: ISO-1989-1985). * IC2334.2 041300* * IC2334.2 041400* THIS CCVS INCORPORATES ENHANCEMENTS TO THE CCVS FOR THE * IC2334.2 041500* 1974 STANDARD (ANSI DOCUMENT REFERENCE: X3.23-1974; ISO * IC2334.2 041600* DOCUMENT REFERENCE: ISO-1989-1978). * IC2334.2 041700* * IC2334.2 041800* THESE ENHANCEMENTS WERE SPECIFIED BY A PROJECT TEAM WHICH * IC2334.2 041900* WAS FUNDED BY THE COMMISSION FOR EUROPEAN COMMUNITIES AND * IC2334.2 042000* WHICH WAS RESPONSIBLE FOR TECHNICAL ISSUES TO: * IC2334.2 042100* * IC2334.2 042200* THE FEDERAL SOFTWARE TESTING CENTER * IC2334.2 042300* OFFICE OF SOFTWARE DEVELOPMENT * IC2334.2 042400* & INFORMATION TECHNOLOGY * IC2334.2 042500* TWO SKYLINE PLACE * IC2334.2 042600* SUITE 1100 * IC2334.2 042700* 5203 LEESBURG PIKE * IC2334.2 042800* FALLS CHURCH * IC2334.2 042900* VA 22041 * IC2334.2 043000* U.S.A. * IC2334.2 043100* * IC2334.2 043200* THE PROJECT TEAM MEMBERS WERE: * IC2334.2 043300* * IC2334.2 043400* BIADI (BUREAU INTER ADMINISTRATION * IC2334.2 043500* DE DOCUMENTATION INFORMATIQUE) * IC2334.2 043600* 21 RUE BARA * IC2334.2 043700* F-92132 ISSY * IC2334.2 043800* FRANCE * IC2334.2 043900* * IC2334.2 044000* * IC2334.2 044100* GMD (GESELLSCHAFT FUR MATHEMATIK * IC2334.2 044200* UND DATENVERARBEITUNG MBH) * IC2334.2 044300* SCHLOSS BIRLINGHOVEN * IC2334.2 044400* POSTFACH 12 40 * IC2334.2 044500* D-5205 ST. AUGUSTIN 1 * IC2334.2 044600* GERMANY FR * IC2334.2 044700* * IC2334.2 044800* * IC2334.2 044900* NCC (THE NATIONAL COMPUTING CENTRE LTD) * IC2334.2 045000* OXFORD ROAD * IC2334.2 045100* MANCHESTER * IC2334.2 045200* M1 7ED * IC2334.2 045300* UNITED KINGDOM * IC2334.2 045400* * IC2334.2 045500* * IC2334.2 045600* THIS TEST SUITE WAS PRODUCED BY THE NATIONAL COMPUTING * IC2334.2 045700* CENTRE IN ENGLAND AND IS THE OFFICIAL CCVS TEST SUITE * IC2334.2 045800* USED THROUGHOUT EUROPE AND THE UNITED STATES OF AMERICA. * IC2334.2 045900* * IC2334.2 046000**************************************************************** IC2334.2 046100* * IC2334.2 046200* VALIDATION FOR:- * IC2334.2 046300* * IC2334.2 046400* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2334.2 046500* * IC2334.2 046600* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2334.2 046700* * IC2334.2 046800**************************************************************** IC2334.2 046900* * IC2334.2 047000* X-CARDS USED BY THIS PROGRAM ARE :- * IC2334.2 047100* * IC2334.2 047200* X-55 - SYSTEM PRINTER NAME. * IC2334.2 047300* X-82 - SOURCE COMPUTER NAME. * IC2334.2 047400* X-83 - OBJECT COMPUTER NAME. * IC2334.2 047500* X-92 - TEST-FILE. * IC2334.2 047600* * IC2334.2 047700**************************************************************** IC2334.2 047800* * IC2334.2 047900* PROGRAMS IC233A AND IC233A-1 TEST THAT A "USE" PROCEDURE * IC2334.2 048000* IN A CALLING PROGRAM IS INVOKED BY A QUALIFYING CONDITION * IC2334.2 048100* OCCURRING IN A CONTAINED PROGRAM. * IC2334.2 048200* * IC2334.2 048300* BOTH PROGRAMS WILL BE COMPILED IN ONE INVOCATION OF THE * IC2334.2 048400* COMPILER AS SHOWN BELOW: * IC2334.2 048500* IDENTIFICATION DIVISION. * IC2334.2 048600* PROGRAM-ID. IC233A. * IC2334.2 048700* . * IC2334.2 048800* . * IC2334.2 048900* . * IC2334.2 049000* IDENTIFICATION DIVISION. * IC2334.2 049100* PROGRAM-ID. IC233A-1. * IC2334.2 049200* . * IC2334.2 049300* . * IC2334.2 049400* END PROGRAM IC233A-1. * IC2334.2 049500* END PROGRAM IC233A. * IC2334.2 049600**************************************************************** IC2334.2 049700*ENVIRONMENT DIVISION. IC2334.2 049800*INPUT-OUTPUT SECTION. IC2334.2 049900*FILE-CONTROL. IC2334.2 050000* SELECT TEST-FILE ASSIGN TO IC2334.2 050100* XXXXX018. IC2334.2 050200 DATA DIVISION. IC2334.2 050300 FILE SECTION. IC2334.2 050400 WORKING-STORAGE SECTION. IC2334.2 050500 PROCEDURE DIVISION. IC2334.2 050600 SECT-IC233A-1-001 SECTION. IC2334.2 050700 USE-INIT-1. IC2334.2 050800 OPEN INPUT TEST-FILE. IC2334.2 050900 READ TEST-FILE. IC2334.2 051000 END-PROG. IC2334.2 051100 EXIT PROGRAM. IC2334.2 051200 END PROGRAM IC233A-1. IC2334.2 051300 END PROGRAM IC233A. IC2334.2 ¤ Dauer der Verarbeitung: 0.34 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 |
