|
000100 IDENTIFICATION DIVISION. IC2354.2
000200 PROGRAM-ID. IC2354.2
000300 IC235A. IC2354.2
000400**************************************************************** IC2354.2
000500* * IC2354.2
000600* VALIDATION FOR:- * IC2354.2
000700* * IC2354.2
000800* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2354.2
000900* * IC2354.2
001000* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2354.2
001100* * IC2354.2
001200**************************************************************** IC2354.2
001300* * IC2354.2
001400* X-CARDS USED BY THIS PROGRAM ARE :- * IC2354.2
001500* * IC2354.2
001600* X-55 - SYSTEM PRINTER NAME. * IC2354.2
001700* X-82 - SOURCE COMPUTER NAME. * IC2354.2
001800* X-83 - OBJECT COMPUTER NAME. * IC2354.2
001900* * IC2354.2
002000**************************************************************** IC2354.2
002100* THIS PROGRAM TESTS THE USE OF MULTIPLE DATA-NAMES IC2354.2
002200* IN THE USING PHRASE OF THE CALL STATEMENT. TWO 01 GROUP IC2354.2
002300* ITEMS AND AN ELEMENTARY 77 ITEM ARE THE PARAMETERS. THE IC2354.2
002400* DATA DEFINITIONS FOR THE GROUP ITEM PARAMETERS ARE NOT IC2354.2
002500* THE SAME AS IN THE SUBPROGRAM BUT THE NUMBER OF CHARACTERS IC2354.2
002600* ARE IDENTICAL. IC2354.2
002700* THIS PROGRAM ALSO CALLS A SUBPROGRAM WITH MORE IC2354.2
002800* THAN ONE EXIT PROGRAM STATEMENT. IC2354.2
002900* REFERENCE: AMERICAN NATIONAL STANDARD IC2354.2
003000* PROGRAMMING LANGUAGE COBOL, X3.23-1985. IC2354.2
003100 ENVIRONMENT DIVISION. IC2354.2
003200 CONFIGURATION SECTION. IC2354.2
003300 SOURCE-COMPUTER. IC2354.2
003400 Card0130. IC2354.2
003500 OBJECT-COMPUTER. IC2354.2
003600 Card0131. IC2354.2
003700 INPUT-OUTPUT SECTION. IC2354.2
003800 FILE-CONTROL. IC2354.2
003900 SELECT PRINT-FILE ASSIGN TO IC2354.2
004000 "C0085" . IC2354.2
004100 DATA DIVISION. IC2354.2
004200 FILE SECTION. IC2354.2
004300 FD PRINT-FILE. IC2354.2
004400 01 PRINT-REC PICTURE X(120). IC2354.2
004500 01 DUMMY-RECORD PICTURE X(120). IC2354.2
004600 WORKING-STORAGE SECTION. IC2354.2
004700 77 MAIN-DN1 PICTURE 999. IC2354.2
004800 77 MAIN-DN2 PICTURE S99 COMPUTATIONAL. IC2354.2
004900 77 ELEM-77 PICTURE V9(4) COMPUTATIONAL. IC2354.2
005000 01 GROUP-01. IC2354.2
005100 02 ALPHA-NUM-FIELD PIC X(8). IC2354.2
005200 02 GROUP-LEV2. IC2354.2
005300 03 NUMER-FIELD PIC 99. IC2354.2
005400 03 ALPHA-FIELD PIC A(3). IC2354.2
005500 01 GROUP-02. IC2354.2
005600 02 NUM-ITEM PIC S99. IC2354.2
005700 02 ALPHA-EDITED PICTURE X(6). IC2354.2
005800 01 GROUP-03. IC2354.2
005900 02 ALPHA-NUM-FIELD-3 PIC X(5). IC2354.2
006000 02 GROUP-LEV2-3. IC2354.2
006100 03 NUMER-FIELD-3 PIC 99. IC2354.2
006200 03 ALPHA-FIELD-3 PIC A(3). IC2354.2
006300 01 GROUP-04. IC2354.2
006400 03 FILLER PIC XX. IC2354.2
006500 03 ELEM-NON-01 PIC XX. IC2354.2
006600 01 FILLER. IC2354.2
006700 03 SUBSCRIPTED-DATA OCCURS 10 IC2354.2
006800 PIC XX. IC2354.2
006900 01 TEST-RESULTS. IC2354.2
007000 02 FILLER PIC X VALUE SPACE. IC2354.2
007100 02 FEATURE PIC X(20) VALUE SPACE. IC2354.2
007200 02 FILLER PIC X VALUE SPACE. IC2354.2
007300 02 P-OR-F PIC X(5) VALUE SPACE. IC2354.2
007400 02 FILLER PIC X VALUE SPACE. IC2354.2
007500 02 PAR-NAME. IC2354.2
007600 03 FILLER PIC X(19) VALUE SPACE. IC2354.2
007700 03 PARDOT-X PIC X VALUE SPACE. IC2354.2
007800 03 DOTVALUE PIC 99 VALUE ZERO. IC2354.2
007900 02 FILLER PIC X(8) VALUE SPACE. IC2354.2
008000 02 RE-MARK PIC X(61). IC2354.2
008100 01 TEST-COMPUTED. IC2354.2
008200 02 FILLER PIC X(30) VALUE SPACE. IC2354.2
008300 02 FILLER PIC X(17) VALUE IC2354.2
008400 " COMPUTED=". IC2354.2
008500 02 COMPUTED-X. IC2354.2
008600 03 COMPUTED-A PIC X(20) VALUE SPACE. IC2354.2
008700 03 COMPUTED-N REDEFINES COMPUTED-A IC2354.2
008800 PIC -9(9).9(9). IC2354.2
008900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IC2354.2
009000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IC2354.2
009100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IC2354.2
009200 03 CM-18V0 REDEFINES COMPUTED-A. IC2354.2
009300 04 COMPUTED-18V0 PIC -9(18). IC2354.2
009400 04 FILLER PIC X. IC2354.2
009500 03 FILLER PIC X(50) VALUE SPACE. IC2354.2
009600 01 TEST-CORRECT. IC2354.2
009700 02 FILLER PIC X(30) VALUE SPACE. IC2354.2
009800 02 FILLER PIC X(17) VALUE " CORRECT =". IC2354.2
009900 02 CORRECT-X. IC2354.2
010000 03 CORRECT-A PIC X(20) VALUE SPACE. IC2354.2
010100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IC2354.2
010200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IC2354.2
010300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IC2354.2
010400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IC2354.2
010500 03 CR-18V0 REDEFINES CORRECT-A. IC2354.2
010600 04 CORRECT-18V0 PIC -9(18). IC2354.2
010700 04 FILLER PIC X. IC2354.2
010800 03 FILLER PIC X(2) VALUE SPACE. IC2354.2
010900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IC2354.2
011000 01 CCVS-C-1. IC2354.2
011100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIC2354.2
011200- "SS PARAGRAPH-NAME IC2354.2
011300- " REMARKS". IC2354.2
011400 02 FILLER PIC X(20) VALUE SPACE. IC2354.2
011500 01 CCVS-C-2. IC2354.2
011600 02 FILLER PIC X VALUE SPACE. IC2354.2
011700 02 FILLER PIC X(6) VALUE "TESTED". IC2354.2
011800 02 FILLER PIC X(15) VALUE SPACE. IC2354.2
011900 02 FILLER PIC X(4) VALUE "FAIL". IC2354.2
012000 02 FILLER PIC X(94) VALUE SPACE. IC2354.2
012100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IC2354.2
012200 01 REC-CT PIC 99 VALUE ZERO. IC2354.2
012300 01 DELETE-COUNTER PIC 999 VALUE ZERO. IC2354.2
012400 01 ERROR-COUNTER PIC 999 VALUE ZERO. IC2354.2
012500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IC2354.2
012600 01 PASS-COUNTER PIC 999 VALUE ZERO. IC2354.2
012700 01 TOTAL-ERROR PIC 999 VALUE ZERO. IC2354.2
012800 01 ERROR-HOLD PIC 999 VALUE ZERO. IC2354.2
012900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IC2354.2
013000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IC2354.2
013100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IC2354.2
013200 01 CCVS-H-1. IC2354.2
013300 02 FILLER PIC X(39) VALUE SPACES. IC2354.2
013400 02 FILLER PIC X(42) VALUE IC2354.2
013500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IC2354.2
013600 02 FILLER PIC X(39) VALUE SPACES. IC2354.2
013700 01 CCVS-H-2A. IC2354.2
013800 02 FILLER PIC X(40) VALUE SPACE. IC2354.2
013900 02 FILLER PIC X(7) VALUE "CCVS85 ". IC2354.2
014000 02 FILLER PIC XXXX VALUE IC2354.2
014100 "4.2 ". IC2354.2
014200 02 FILLER PIC X(28) VALUE IC2354.2
014300 " COPY - NOT FOR DISTRIBUTION". IC2354.2
014400 02 FILLER PIC X(41) VALUE SPACE. IC2354.2
014500 IC2354.2
014600 01 CCVS-H-2B. IC2354.2
014700 02 FILLER PIC X(15) VALUE IC2354.2
014800 "TEST RESULT OF ". IC2354.2
014900 02 TEST-ID PIC X(9). IC2354.2
015000 02 FILLER PIC X(4) VALUE IC2354.2
015100 " IN ". IC2354.2
015200 02 FILLER PIC X(12) VALUE IC2354.2
015300 " HIGH ". IC2354.2
015400 02 FILLER PIC X(22) VALUE IC2354.2
015500 " LEVEL VALIDATION FOR ". IC2354.2
015600 02 FILLER PIC X(58) VALUE IC2354.2
015700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2354.2
015800 01 CCVS-H-3. IC2354.2
015900 02 FILLER PIC X(34) VALUE IC2354.2
016000 " FOR OFFICIAL USE ONLY ". IC2354.2
016100 02 FILLER PIC X(58) VALUE IC2354.2
016200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2354.2
016300 02 FILLER PIC X(28) VALUE IC2354.2
016400 " COPYRIGHT 1985 ". IC2354.2
016500 01 CCVS-E-1. IC2354.2
016600 02 FILLER PIC X(52) VALUE SPACE. IC2354.2
016700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IC2354.2
016800 02 ID-AGAIN PIC X(9). IC2354.2
016900 02 FILLER PIC X(45) VALUE SPACES. IC2354.2
017000 01 CCVS-E-2. IC2354.2
017100 02 FILLER PIC X(31) VALUE SPACE. IC2354.2
017200 02 FILLER PIC X(21) VALUE SPACE. IC2354.2
017300 02 CCVS-E-2-2. IC2354.2
017400 03 ERROR-TOTAL PIC XXX VALUE SPACE. IC2354.2
017500 03 FILLER PIC X VALUE SPACE. IC2354.2
017600 03 ENDER-DESC PIC X(44) VALUE IC2354.2
017700 "ERRORS ENCOUNTERED". IC2354.2
017800 01 CCVS-E-3. IC2354.2
017900 02 FILLER PIC X(22) VALUE IC2354.2
018000 " FOR OFFICIAL USE ONLY". IC2354.2
018100 02 FILLER PIC X(12) VALUE SPACE. IC2354.2
018200 02 FILLER PIC X(58) VALUE IC2354.2
018300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2354.2
018400 02 FILLER PIC X(13) VALUE SPACE. IC2354.2
018500 02 FILLER PIC X(15) VALUE IC2354.2
018600 " COPYRIGHT 1985". IC2354.2
018700 01 CCVS-E-4. IC2354.2
018800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IC2354.2
018900 02 FILLER PIC X(4) VALUE " OF ". IC2354.2
019000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IC2354.2
019100 02 FILLER PIC X(40) VALUE IC2354.2
019200 " TESTS WERE EXECUTED SUCCESSFULLY". IC2354.2
019300 01 XXINFO. IC2354.2
019400 02 FILLER PIC X(19) VALUE IC2354.2
019500 "*** INFORMATION ***". IC2354.2
019600 02 INFO-TEXT. IC2354.2
019700 04 FILLER PIC X(8) VALUE SPACE. IC2354.2
019800 04 XXCOMPUTED PIC X(20). IC2354.2
019900 04 FILLER PIC X(5) VALUE SPACE. IC2354.2
020000 04 XXCORRECT PIC X(20). IC2354.2
020100 02 INF-ANSI-REFERENCE PIC X(48). IC2354.2
020200 01 HYPHEN-LINE. IC2354.2
020300 02 FILLER PIC IS X VALUE IS SPACE. IC2354.2
020400 02 FILLER PIC IS X(65) VALUE IS "************************IC2354.2
020500- "*****************************************". IC2354.2
020600 02 FILLER PIC IS X(54) VALUE IS "************************IC2354.2
020700- "******************************". IC2354.2
020800 01 CCVS-PGM-ID PIC X(9) VALUE IC2354.2
020900 "IC235A". IC2354.2
021000 PROCEDURE DIVISION. IC2354.2
021100 CCVS1 SECTION. IC2354.2
021200 OPEN-FILES. IC2354.2
021300 OPEN OUTPUT PRINT-FILE. IC2354.2
021400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IC2354.2
021500 MOVE SPACE TO TEST-RESULTS. IC2354.2
021600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IC2354.2
021700 GO TO CCVS1-EXIT. IC2354.2
021800 CLOSE-FILES. IC2354.2
021900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IC2354.2
022000 TERMINATE-CCVS. IC2354.2
022100 EXIT PROGRAM. IC2354.2
022200 TERMINATE-CALL. IC2354.2
022300 STOP RUN. IC2354.2
022400 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IC2354.2
022500 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IC2354.2
022600 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IC2354.2
022700 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IC2354.2
022800 MOVE "****TEST DELETED****" TO RE-MARK. IC2354.2
022900 PRINT-DETAIL. IC2354.2
023000 IF REC-CT NOT EQUAL TO ZERO IC2354.2
023100 MOVE "." TO PARDOT-X IC2354.2
023200 MOVE REC-CT TO DOTVALUE. IC2354.2
023300 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IC2354.2
023400 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IC2354.2
023500 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IC2354.2
023600 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IC2354.2
023700 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IC2354.2
023800 MOVE SPACE TO CORRECT-X. IC2354.2
023900 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IC2354.2
024000 MOVE SPACE TO RE-MARK. IC2354.2
024100 HEAD-ROUTINE. IC2354.2
024200 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2354.2
024300 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2354.2
024400 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2354.2
024500 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IC2354.2
024600 COLUMN-NAMES-ROUTINE. IC2354.2
024700 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2354.2
024800 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2354.2
024900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2354.2
025000 END-ROUTINE. IC2354.2
025100 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IC2354.2
025200 END-RTN-EXIT. IC2354.2
025300 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2354.2
025400 END-ROUTINE-1. IC2354.2
025500 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IC2354.2
025600 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IC2354.2
025700 ADD PASS-COUNTER TO ERROR-HOLD. IC2354.2
025800* IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12. IC2354.2
025900 MOVE PASS-COUNTER TO CCVS-E-4-1. IC2354.2
026000 MOVE ERROR-HOLD TO CCVS-E-4-2. IC2354.2
026100 MOVE CCVS-E-4 TO CCVS-E-2-2. IC2354.2
026200 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IC2354.2
026300 END-ROUTINE-12. IC2354.2
026400 MOVE "TEST(S) FAILED" TO ENDER-DESC. IC2354.2
026500 IF ERROR-COUNTER IS EQUAL TO ZERO IC2354.2
026600 MOVE "NO " TO ERROR-TOTAL IC2354.2
026700 ELSE IC2354.2
026800 MOVE ERROR-COUNTER TO ERROR-TOTAL. IC2354.2
026900 MOVE CCVS-E-2 TO DUMMY-RECORD. IC2354.2
027000 PERFORM WRITE-LINE. IC2354.2
027100 END-ROUTINE-13. IC2354.2
027200 IF DELETE-COUNTER IS EQUAL TO ZERO IC2354.2
027300 MOVE "NO " TO ERROR-TOTAL ELSE IC2354.2
027400 MOVE DELETE-COUNTER TO ERROR-TOTAL. IC2354.2
027500 MOVE "TEST(S) DELETED " TO ENDER-DESC. IC2354.2
027600 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2354.2
027700 IF INSPECT-COUNTER EQUAL TO ZERO IC2354.2
027800 MOVE "NO " TO ERROR-TOTAL IC2354.2
027900 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IC2354.2
028000 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IC2354.2
028100 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2354.2
028200 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IC2354.2
028300 WRITE-LINE. IC2354.2
028400 ADD 1 TO RECORD-COUNT. IC2354.2
028500 IF RECORD-COUNT GREATER 50 IC2354.2
028600 MOVE DUMMY-RECORD TO DUMMY-HOLD IC2354.2
028700 MOVE SPACE TO DUMMY-RECORD IC2354.2
028800 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IC2354.2
028900 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IC2354.2
029000 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IC2354.2
029100 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IC2354.2
029200 MOVE DUMMY-HOLD TO DUMMY-RECORD IC2354.2
029300 MOVE ZERO TO RECORD-COUNT. IC2354.2
029400 PERFORM WRT-LN. IC2354.2
029500 WRT-LN. IC2354.2
029600 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IC2354.2
029700 MOVE SPACE TO DUMMY-RECORD. IC2354.2
029800 BLANK-LINE-PRINT. IC2354.2
029900 PERFORM WRT-LN. IC2354.2
030000 FAIL-ROUTINE. IC2354.2
030100 IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE. IC2354.2
030200 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IC2354.2
030300 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2354.2
030400 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IC2354.2
030500 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2354.2
030600 MOVE SPACES TO INF-ANSI-REFERENCE. IC2354.2
030700 GO TO FAIL-ROUTINE-EX. IC2354.2
030800 FAIL-ROUTINE-WRITE. IC2354.2
030900 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IC2354.2
031000 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IC2354.2
031100 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IC2354.2
031200 MOVE SPACES TO COR-ANSI-REFERENCE. IC2354.2
031300 FAIL-ROUTINE-EX. EXIT. IC2354.2
031400 BAIL-OUT. IC2354.2
031500 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IC2354.2
031600 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IC2354.2
031700 BAIL-OUT-WRITE. IC2354.2
031800 MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED. IC2354.2
031900 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IC2354.2
032000 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IC2354.2
032100 MOVE SPACES TO INF-ANSI-REFERENCE. IC2354.2
032200 BAIL-OUT-EX. EXIT. IC2354.2
032300 CCVS1-EXIT. IC2354.2
032400 EXIT. IC2354.2
032500 SECT-IC235-0001 SECTION. IC2354.2
032600* THE TESTS IN THIS SECTION CALL A SUBPROGRAM WHICH IC2354.2
032700* HAS FOUR EXIT PROGRAM STATEMENTS. A DIFFERENT EXIT IS IC2354.2
032800* TAKEN FOR EACH CALL TO THE SUBPROGRAM. IC2354.2
032900 EXIT-INIT. IC2354.2
033000 MOVE "MULTIPLE EXIT PROGRM" TO FEATURE. IC2354.2
033100 EXIT-INIT-001. IC2354.2
033200 MOVE 0 TO MAIN-DN2. IC2354.2
033300 MOVE 1 TO MAIN-DN1. IC2354.2
033400 EXIT-TEST-001. IC2354.2
033500 CALL "IC235A-2" USING MAIN-DN1 MAIN-DN2. IC2354.2
033600 IF MAIN-DN2 EQUAL TO 1 IC2354.2
033700 PERFORM PASS IC2354.2
033800 GO TO EXIT-WRITE-001. IC2354.2
033900 EXIT-FAIL-001. IC2354.2
034000 MOVE MAIN-DN1 TO CORRECT-18V0. IC2354.2
034100 MOVE MAIN-DN2 TO COMPUTED-18V0. IC2354.2
034200 MOVE "FIRST EXIT FROM SUBPROGRAM" TO RE-MARK. IC2354.2
034300 PERFORM FAIL. IC2354.2
034400 EXIT-WRITE-001. IC2354.2
034500 MOVE "EXIT-TEST-01" TO PAR-NAME. IC2354.2
034600 PERFORM PRINT-DETAIL. IC2354.2
034700 EXIT-INIT-002. IC2354.2
034800 MOVE 0 TO MAIN-DN2. IC2354.2
034900 MOVE 2 TO MAIN-DN1. IC2354.2
035000 EXIT-TEST-002. IC2354.2
035100 CALL "IC235A-2" USING MAIN-DN1 MAIN-DN2. IC2354.2
035200 IF MAIN-DN2 EQUAL TO 2 IC2354.2
035300 PERFORM PASS IC2354.2
035400 GO TO EXIT-WRITE-002. IC2354.2
035500 EXIT-FAIL-002. IC2354.2
035600 MOVE MAIN-DN1 TO CORRECT-18V0. IC2354.2
035700 MOVE MAIN-DN2 TO COMPUTED-18V0. IC2354.2
035800 MOVE "SECOND EXIT FROM SUBPROGRAM" TO RE-MARK. IC2354.2
035900 PERFORM FAIL. IC2354.2
036000 EXIT-WRITE-002. IC2354.2
036100 MOVE "EXIT-TEST-02" TO PAR-NAME. IC2354.2
036200 PERFORM PRINT-DETAIL. IC2354.2
036300 EXIT-INIT-003. IC2354.2
036400 MOVE 0 TO MAIN-DN2. IC2354.2
036500 MOVE 3 TO MAIN-DN1. IC2354.2
036600 EXIT-TEST-003. IC2354.2
036700 CALL "IC235A-2" USING MAIN-DN1 MAIN-DN2. IC2354.2
036800 IF MAIN-DN2 NOT EQUAL TO 3 IC2354.2
036900 GO TO EXIT-FAIL-003. IC2354.2
037000 PERFORM PASS. IC2354.2
037100 GO TO EXIT-WRITE-003. IC2354.2
037200 EXIT-FAIL-003. IC2354.2
037300 MOVE MAIN-DN1 TO CORRECT-18V0. IC2354.2
037400 MOVE MAIN-DN2 TO COMPUTED-18V0. IC2354.2
037500 MOVE "THIRD EXIT FROM SUBPROGRAM" TO RE-MARK. IC2354.2
037600 PERFORM FAIL. IC2354.2
037700 EXIT-WRITE-003. IC2354.2
037800 MOVE "EXIT-TEST-03" TO PAR-NAME. IC2354.2
037900 PERFORM PRINT-DETAIL. IC2354.2
038000 EXIT-INIT-004. IC2354.2
038100 MOVE 0 TO MAIN-DN2. IC2354.2
038200 MOVE 4 TO MAIN-DN1. IC2354.2
038300 EXIT-TEST-004. IC2354.2
038400 CALL "IC235A-2" USING MAIN-DN1 MAIN-DN2. IC2354.2
038500 IF MAIN-DN2 NOT EQUAL TO 4 IC2354.2
038600 GO TO EXIT-FAIL-004. IC2354.2
038700 PERFORM PASS. IC2354.2
038800 GO TO EXIT-WRITE-004. IC2354.2
038900 EXIT-FAIL-004. IC2354.2
039000 MOVE MAIN-DN1 TO CORRECT-18V0. IC2354.2
039100 MOVE MAIN-DN2 TO COMPUTED-18V0. IC2354.2
039200 MOVE "FOURTH EXIT FROM SUBPROGRAM" TO RE-MARK. IC2354.2
039300 PERFORM FAIL. IC2354.2
039400 EXIT-WRITE-004. IC2354.2
039500 MOVE "EXIT-TEST-04" TO PAR-NAME. IC2354.2
039600 PERFORM PRINT-DETAIL. IC2354.2
039700 GO TO SECT-IC235-0002. IC2354.2
039800 EXIT-DELETES. IC2354.2
039900* IF THE SUBPROGRAM WITH MULTIPLE EXIT PROGRAM IC2354.2
040000* STATEMENTS CANNOT BE INCLUDED IN THE RUN UNIT IC2354.2
040100* DELETE PARAGRAPH EXIT-INIT-001 THRU EXIT-WRITE-004. IC2354.2
040200 PERFORM DE-LETE. IC2354.2
040300 MOVE "EXIT-TEST-01" TO PAR-NAME. IC2354.2
040400 PERFORM PRINT-DETAIL. IC2354.2
040500 PERFORM DE-LETE. IC2354.2
040600 MOVE "EXIT-TEST-02" TO PAR-NAME. IC2354.2
040700 PERFORM PRINT-DETAIL. IC2354.2
040800 PERFORM DE-LETE. IC2354.2
040900 MOVE "EXIT-TEST-03" TO PAR-NAME. IC2354.2
041000 PERFORM PRINT-DETAIL. IC2354.2
041100 PERFORM DE-LETE. IC2354.2
041200 MOVE "EXIT-TEST-04" TO PAR-NAME. IC2354.2
041300 PERFORM PRINT-DETAIL. IC2354.2
041400 SECT-IC235-0002 SECTION. IC2354.2
041500* THIS SECTION CALLS A SUBPROGRAM WITH TWO GROUP ITEMS IC2354.2
041600* AND ONE ELEMENTARY ITEM IN THE USING PHRASE. THE ITEM IC2354.2
041700* DESCRIPTIONS ARE DIFFERENT IN THE SUBPROGRAM FROM THE MAIN IC2354.2
041800* PROGRAM, BUT THE NUMBER OF CHARACTERS IS IDENTICAL. IC2354.2
041900 CALL-INIT-06. IC2354.2
042000 MOVE "CALL-TEST-06" TO PAR-NAME. IC2354.2
042100 MOVE 0 TO NUMER-FIELD ELEM-77 NUM-ITEM. IC2354.2
042200 MOVE SPACE TO ALPHA-NUM-FIELD ALPHA-FIELD ALPHA-EDITED. IC2354.2
042300 MOVE 11 TO ELEM-NON-01. IC2354.2
042400 MOVE 99 TO SUBSCRIPTED-DATA (4). IC2354.2
042500 MOVE "CALL USING DN SERIES" TO FEATURE. IC2354.2
042600 CALL-TEST-06. IC2354.2
042700 CALL "IC235A-1" USING GROUP-01 ELEM-77 GROUP-02 IC2354.2
042800 ELEM-NON-01 SUBSCRIPTED-DATA (4). IC2354.2
042900 GO TO CALL-TEST-06-01. IC2354.2
043000 CALL-DELETE-06. IC2354.2
043100 PERFORM DE-LETE. IC2354.2
043200 PERFORM PRINT-DETAIL. IC2354.2
043300 GO TO CCVS-EXIT. IC2354.2
043400* IF IC235A-1 CANNOT BE INCLUDED IN THE RUN UNIT IC2354.2
043500* DELETE THE PARAGRAPH CALL-TEST-06. IC2354.2
043600 CALL-TEST-06-01. IC2354.2
043700 IF ALPHA-NUM-FIELD NOT EQUAL TO "IC235A-1" IC2354.2
043800 GO TO CALL-FAIL-06-01. IC2354.2
043900 PERFORM PASS. IC2354.2
044000 GO TO CALL-WRITE-06-01. IC2354.2
044100 CALL-FAIL-06-01. IC2354.2
044200 MOVE ALPHA-NUM-FIELD TO COMPUTED-A. IC2354.2
044300 MOVE "IC235A-1" TO CORRECT-A. IC2354.2
044400 PERFORM FAIL. IC2354.2
044500 MOVE "ALPHANUMERIC PARAMETER" TO RE-MARK. IC2354.2
044600 CALL-WRITE-06-01. IC2354.2
044700 ADD 1 TO REC-CT. IC2354.2
044800 PERFORM PRINT-DETAIL. IC2354.2
044900 CALL-TEST-06-02. IC2354.2
045000 IF NUMER-FIELD EQUAL TO 25 IC2354.2
045100 PERFORM PASS IC2354.2
045200 GO TO CALL-WRITE-06-02. IC2354.2
045300 CALL-FAIL-06-02. IC2354.2
045400 PERFORM FAIL. IC2354.2
045500 MOVE NUMER-FIELD TO COMPUTED-18V0. IC2354.2
045600 MOVE 25 TO CORRECT-18V0. IC2354.2
045700 MOVE "NUMERIC DISPLAY PARAMETER" TO RE-MARK. IC2354.2
045800 CALL-WRITE-06-02. IC2354.2
045900 ADD 1 TO REC-CT. IC2354.2
046000 PERFORM PRINT-DETAIL. IC2354.2
046100 CALL-TEST-06-03. IC2354.2
046200 IF ALPHA-FIELD EQUAL TO "YES" IC2354.2
046300 PERFORM PASS IC2354.2
046400 GO TO CALL-WRITE-06-03. IC2354.2
046500 CALL-FAIL-06-03. IC2354.2
046600 PERFORM FAIL. IC2354.2
046700 MOVE ALPHA-FIELD TO COMPUTED-A. IC2354.2
046800 MOVE "YES" TO CORRECT-A. IC2354.2
046900 MOVE "ALPHABETIC PARAMETER" TO RE-MARK. IC2354.2
047000 CALL-WRITE-06-03. IC2354.2
047100 ADD 1 TO REC-CT. IC2354.2
047200 PERFORM PRINT-DETAIL. IC2354.2
047300 CALL-TEST-06-04. IC2354.2
047400 IF ELEM-77 EQUAL TO 0.7654 IC2354.2
047500 PERFORM PASS IC2354.2
047600 GO TO CALL-WRITE-06-04. IC2354.2
047700 CALL-FAIL-06-04. IC2354.2
047800 PERFORM FAIL. IC2354.2
047900 MOVE ELEM-77 TO COMPUTED-4V14. IC2354.2
048000 MOVE 0.7654 TO CORRECT-4V14. IC2354.2
048100 MOVE "COMPUTATIONAL PARAMETER" TO RE-MARK. IC2354.2
048200 CALL-WRITE-06-04. IC2354.2
048300 ADD 1 TO REC-CT. IC2354.2
048400 PERFORM PRINT-DETAIL. IC2354.2
048500 CALL-TEST-06-05. IC2354.2
048600 IF NUM-ITEM EQUAL TO 25 IC2354.2
048700 PERFORM PASS IC2354.2
048800 GO TO CALL-WRITE-06-05. IC2354.2
048900 CALL-FAIL-06-05. IC2354.2
049000 PERFORM FAIL. IC2354.2
049100 MOVE NUM-ITEM TO COMPUTED-18V0. IC2354.2
049200 MOVE 25 TO CORRECT-18V0. IC2354.2
049300 MOVE "SIGNED NUMERIC PARAMETER" TO RE-MARK. IC2354.2
049400 CALL-WRITE-06-05. IC2354.2
049500 ADD 1 TO REC-CT. IC2354.2
049600 PERFORM PRINT-DETAIL. IC2354.2
049700 CALL-TEST-06-06. IC2354.2
049800 IF ALPHA-EDITED EQUAL TO "AB C0D" IC2354.2
049900 PERFORM PASS IC2354.2
050000 GO TO CALL-WRITE-06-06. IC2354.2
050100 CALL-FAIL-06-06. IC2354.2
050200 PERFORM FAIL. IC2354.2
050300 MOVE ALPHA-EDITED TO COMPUTED-A. IC2354.2
050400 MOVE "AB C0D" TO CORRECT-A. IC2354.2
050500 MOVE "ALPHANUMERIC EDITED" TO RE-MARK. IC2354.2
050600 CALL-WRITE-06-06. IC2354.2
050700 ADD 1 TO REC-CT. IC2354.2
050800 PERFORM PRINT-DETAIL. IC2354.2
050900 CALL-TEST-06-07. IC2354.2
051000 IF ELEM-NON-01 = "ZZ" IC2354.2
051100 PERFORM PASS IC2354.2
051200 GO TO CALL-WRITE-06-07. IC2354.2
051300 CALL-FAIL-06-07. IC2354.2
051400 PERFORM FAIL. IC2354.2
051500 MOVE ELEM-NON-01 TO COMPUTED-A. IC2354.2
051600 MOVE "ZZ" TO CORRECT-A. IC2354.2
051700 MOVE "ELEMENTARY NON LEVEL-01 DATA ITEM" TO RE-MARK. IC2354.2
051800 CALL-WRITE-06-07. IC2354.2
051900 MOVE "X-27 5.2.3 SR3" TO ANSI-REFERENCE. IC2354.2
052000 ADD 1 TO REC-CT. IC2354.2
052100 PERFORM PRINT-DETAIL. IC2354.2
052200 CALL-TEST-06-08. IC2354.2
052300 IF SUBSCRIPTED-DATA (4) = "1A" IC2354.2
052400 PERFORM PASS IC2354.2
052500 GO TO CALL-WRITE-06-08. IC2354.2
052600 CALL-FAIL-06-08. IC2354.2
052700 PERFORM FAIL. IC2354.2
052800 MOVE SUBSCRIPTED-DATA (4) TO COMPUTED-A. IC2354.2
052900 MOVE "1A" TO CORRECT-A. IC2354.2
053000 MOVE "SUBSCRIPTED LINKAGE DATA ITEM" TO RE-MARK. IC2354.2
053100 CALL-WRITE-06-08. IC2354.2
053200 MOVE "XVII-46 (59)" TO ANSI-REFERENCE. IC2354.2
053300 ADD 1 TO REC-CT. IC2354.2
053400 PERFORM PRINT-DETAIL. IC2354.2
053500* IC2354.2
053600 GO TO CCVS-EXIT. IC2354.2
053700 CCVS-EXIT SECTION. IC2354.2
053800 CCVS-999999. IC2354.2
053900 GO TO CLOSE-FILES. IC2354.2
054000 IDENTIFICATION DIVISION. IC2354.2
054100 PROGRAM-ID. IC2354.2
054200 IC235A-1. IC2354.2
054300**************************************************************** IC2354.2
054400* * IC2354.2
054500* VALIDATION FOR:- * IC2354.2
054600* * IC2354.2
054700* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2354.2
054800* * IC2354.2
054900* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2354.2
055000* * IC2354.2
055100**************************************************************** IC2354.2
055200* * IC2354.2
055300* X-CARDS USED BY THIS PROGRAM ARE :- * IC2354.2
055400* * IC2354.2
055500* X-55 - SYSTEM PRINTER NAME. * IC2354.2
055600* X-82 - SOURCE COMPUTER NAME. * IC2354.2
055700* X-83 - OBJECT COMPUTER NAME. * IC2354.2
055800* * IC2354.2
055900**************************************************************** IC2354.2
056000* THE SUBPROGRAM IC235A-1 HAS THREE OPERANDS IN THE IC2354.2
056100* USING PHRASE OF THE PROCEDURE DIVISION HEADER. TWO IC2354.2
056200* OPERANDS ARE 01 GROUP ITEMS AND THE THIRD OPERAND IS IC2354.2
056300* AN ELEMENTARY 77 ITEM. THE DATA DESCRIPTIONS OF THESE IC2354.2
056400* OPERANDS IN THE LINKAGE SECTION ARE NOT THE SAME AS THE IC2354.2
056500* DATA DESCRIPTIONS IN THE WORKING-STORAGE SECTION OF THE IC2354.2
056600* CALLING PROGRAM, BUT AN EQUAL NUMBER OF CHARACTER IC2354.2
056700* POSITIONS ARE DEFINED. THE CALLING PROGRAM IS IC235. IC2354.2
056800 ENVIRONMENT DIVISION. IC2354.2
056900 INPUT-OUTPUT SECTION. IC2354.2
057000 FILE-CONTROL. IC2354.2
057100 SELECT PRINT-FILE ASSIGN TO IC2354.2
057200 "C0085" . IC2354.2
057300 DATA DIVISION. IC2354.2
057400 FILE SECTION. IC2354.2
057500 FD PRINT-FILE. IC2354.2
057600 01 PRINT-REC PICTURE X(120). IC2354.2
057700 01 DUMMY-RECORD PICTURE X(120). IC2354.2
057800 WORKING-STORAGE SECTION. IC2354.2
057900 01 CONSTANT-VALUES. IC2354.2
058000 02 AN-CONSTANT PIC X(8) VALUE "IC235A-1". IC2354.2
058100 02 NUM-CONSTANT PIC 99V9999 VALUE 0.7654. IC2354.2
058200 LINKAGE SECTION. IC2354.2
058300 01 GRP-01. IC2354.2
058400 02 AN-FIELD PICTURE X(8). IC2354.2
058500 02 NUM-DISPLAY PIC 99. IC2354.2
058600 02 GRP-LEVEL. IC2354.2
058700 03 A-FIELD PICTURE A(3). IC2354.2
058800 77 ELEM-01 PIC V9(4) COMPUTATIONAL. IC2354.2
058900 01 GRP-02. IC2354.2
059000 02 GRP-03. IC2354.2
059100 03 NUM-ITEM PICTURE S99. IC2354.2
059200 03 EDITED-FIELD PIC XXBX0X. IC2354.2
059300 01 ELEM-NON-01 PIC XX. IC2354.2
059400 01 SUBSCRIPTED-DATA PIC XX. IC2354.2
059500 PROCEDURE DIVISION USING GRP-01 ELEM-01 GRP-02 IC2354.2
059600 ELEM-NON-01 SUBSCRIPTED-DATA. IC2354.2
059700 SECT-IC235A-1-001 SECTION. IC2354.2
059800* THIS SECTION SETS THE PARAMETER FIELDS REFERRED TO IC2354.2
059900* IN THE USING PHRASE AND DEFINED IN THE LINKAGE SECTION. IC2354.2
060000 CALL-TEST-06. IC2354.2
060100 MOVE AN-CONSTANT TO AN-FIELD. IC2354.2
060200 ADD 25 TO NUM-DISPLAY. IC2354.2
060300 MOVE "YES" TO A-FIELD. IC2354.2
060400 MOVE NUM-CONSTANT TO ELEM-01. IC2354.2
060500 MOVE NUM-DISPLAY TO NUM-ITEM. IC2354.2
060600 MOVE "ABCD" TO EDITED-FIELD. IC2354.2
060700 MOVE "ZZ" TO ELEM-NON-01. IC2354.2
060800 MOVE "1A" TO SUBSCRIPTED-DATA. IC2354.2
060900 CALL-EXIT-06. IC2354.2
061000 EXIT PROGRAM. IC2354.2
061100 END PROGRAM IC235A-1. IC2354.2
061200 IDENTIFICATION DIVISION. IC2354.2
061300 PROGRAM-ID. IC2354.2
061400 IC235A-2. IC2354.2
061500**************************************************************** IC2354.2
061600* * IC2354.2
061700* VALIDATION FOR:- * IC2354.2
061800* * IC2354.2
061900* "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IC2354.2
062000* * IC2354.2
062100* "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IC2354.2
062200* * IC2354.2
062300**************************************************************** IC2354.2
062400* * IC2354.2
062500* X-CARDS USED BY THIS PROGRAM ARE :- * IC2354.2
062600* * IC2354.2
062700* X-55 - SYSTEM PRINTER NAME. * IC2354.2
062800* X-82 - SOURCE COMPUTER NAME. * IC2354.2
062900* X-83 - OBJECT COMPUTER NAME. * IC2354.2
063000* * IC2354.2
063100**************************************************************** IC2354.2
063200* THE SUBPROGRAM IC235A-2 HAS TWO OPERANDS IN THE IC2354.2
063300* PROCEDURE DIVISION HEADER AND THE ROUTINE CONTAINS IC2354.2
063400* FOUR EXIT PROGRAM STATEMENTS. THE CALLING PROGRAM IC2354.2
063500* IS IC235. IC2354.2
063600 ENVIRONMENT DIVISION. IC2354.2
063700 DATA DIVISION. IC2354.2
063800 LINKAGE SECTION. IC2354.2
063900 77 DN1 PICTURE 999. IC2354.2
064000 77 DN2 PICTURE S99 COMPUTATIONAL. IC2354.2
064100 PROCEDURE DIVISION USING DN1 DN2. IC2354.2
064200* THIS SUBPROGRAM CONTANS FOUR EXIT PROGRAM STATEMENTS. IC2354.2
064300 SECT-IC235A-2-0001 SECTION. IC2354.2
064400 EXIT-TEST-001. IC2354.2
064500 IF DN1 IS NOT EQUAL TO 1 IC2354.2
064600 GO TO EXIT-TEST-002. IC2354.2
064700 MOVE 1 TO DN2. IC2354.2
064800 EXIT PROGRAM. IC2354.2
064900 EXIT-TEST-002. IC2354.2
065000 IF DN1 IS NOT EQUAL TO 2 IC2354.2
065100 GO TO EXIT-TEST-003. IC2354.2
065200 MOVE 2 TO DN2. IC2354.2
065300 EXIT PROGRAM. IC2354.2
065400 EXIT-TEST-003. IC2354.2
065500 IF DN1 NOT EQUAL TO 3 IC2354.2
065600 GO TO EXIT-TEST-004. IC2354.2
065700 MOVE 3 TO DN2. IC2354.2
065800 EXIT PROGRAM. IC2354.2
065900 EXIT-TEST-004. IC2354.2
066000 MOVE 4 TO DN2. IC2354.2
066100 GO TO EXIT-STATEMENT-004. IC2354.2
066200 EXTRANEOUS-PARAGRAPH. IC2354.2
066300* THIS PARAGRAPH IS NEVER EXECUTED. IC2354.2
066400 MOVE 5 TO DN2. IC2354.2
066500 EXIT-STATEMENT-004. IC2354.2
066600 EXIT PROGRAM. IC2354.2
066700 END PROGRAM IC235A-2. IC2354.2
066800 END PROGRAM IC235A. IC2354.2
¤ Dauer der Verarbeitung: 0.65 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.
|
