|
000100 IDENTIFICATION DIVISION. IF1154.2
000200 PROGRAM-ID. IF1154.2
000300 IF115A. IF1154.2
000400 IF1154.2
000500*********************************************************** IF1154.2
000600* * IF1154.2
000700* This program forms part of the CCVS85 COBOL Test Suite. * IF1154.2
000800* It contains tests for the Intrinsic Function LENGTH. * IF1154.2
000900* * IF1154.2
001000* * IF1154.2
001100*********************************************************** IF1154.2
001200 ENVIRONMENT DIVISION. IF1154.2
001300 CONFIGURATION SECTION. IF1154.2
001400 SOURCE-COMPUTER. IF1154.2
001500 Card0130. IF1154.2
001600 OBJECT-COMPUTER. IF1154.2
001700 Card0131. IF1154.2
001800 INPUT-OUTPUT SECTION. IF1154.2
001900 FILE-CONTROL. IF1154.2
002000 SELECT PRINT-FILE ASSIGN TO IF1154.2
002100 "C0085" . IF1154.2
002200 DATA DIVISION. IF1154.2
002300 FILE SECTION. IF1154.2
002400 FD PRINT-FILE. IF1154.2
002500 01 PRINT-REC PICTURE X(120). IF1154.2
002600 01 DUMMY-RECORD PICTURE X(120). IF1154.2
002700 WORKING-STORAGE SECTION. IF1154.2
002800*********************************************************** IF1154.2
002900* Variables specific to the Intrinsic Function Test IF115A* IF1154.2
003000*********************************************************** IF1154.2
003100 01 K PIC A(1) VALUE "D". IF1154.2
003200 01 M PIC A(17) VALUE "longstringofchars". IF1154.2
003300 01 N PIC A(3) VALUE "abc". IF1154.2
003400 01 C PIC S9(10). IF1154.2
003500 01 WS-INT PIC S9(10). IF1154.2
003600* IF1154.2
003700********************************************************** IF1154.2
003800* IF1154.2
003900 01 TEST-RESULTS. IF1154.2
004000 02 FILLER PIC X VALUE SPACE. IF1154.2
004100 02 FEATURE PIC X(20) VALUE SPACE. IF1154.2
004200 02 FILLER PIC X VALUE SPACE. IF1154.2
004300 02 P-OR-F PIC X(5) VALUE SPACE. IF1154.2
004400 02 FILLER PIC X VALUE SPACE. IF1154.2
004500 02 PAR-NAME. IF1154.2
004600 03 FILLER PIC X(19) VALUE SPACE. IF1154.2
004700 03 PARDOT-X PIC X VALUE SPACE. IF1154.2
004800 03 DOTVALUE PIC 99 VALUE ZERO. IF1154.2
004900 02 FILLER PIC X(8) VALUE SPACE. IF1154.2
005000 02 RE-MARK PIC X(61). IF1154.2
005100 01 TEST-COMPUTED. IF1154.2
005200 02 FILLER PIC X(30) VALUE SPACE. IF1154.2
005300 02 FILLER PIC X(17) VALUE IF1154.2
005400 " COMPUTED=". IF1154.2
005500 02 COMPUTED-X. IF1154.2
005600 03 COMPUTED-A PIC X(20) VALUE SPACE. IF1154.2
005700 03 COMPUTED-N REDEFINES COMPUTED-A IF1154.2
005800 PIC -9(9).9(9). IF1154.2
005900 03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18). IF1154.2
006000 03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14). IF1154.2
006100 03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4). IF1154.2
006200 03 CM-18V0 REDEFINES COMPUTED-A. IF1154.2
006300 04 COMPUTED-18V0 PIC -9(18). IF1154.2
006400 04 FILLER PIC X. IF1154.2
006500 03 FILLER PIC X(50) VALUE SPACE. IF1154.2
006600 01 TEST-CORRECT. IF1154.2
006700 02 FILLER PIC X(30) VALUE SPACE. IF1154.2
006800 02 FILLER PIC X(17) VALUE " CORRECT =". IF1154.2
006900 02 CORRECT-X. IF1154.2
007000 03 CORRECT-A PIC X(20) VALUE SPACE. IF1154.2
007100 03 CORRECT-N REDEFINES CORRECT-A PIC -9(9).9(9). IF1154.2
007200 03 CORRECT-0V18 REDEFINES CORRECT-A PIC -.9(18). IF1154.2
007300 03 CORRECT-4V14 REDEFINES CORRECT-A PIC -9(4).9(14). IF1154.2
007400 03 CORRECT-14V4 REDEFINES CORRECT-A PIC -9(14).9(4). IF1154.2
007500 03 CR-18V0 REDEFINES CORRECT-A. IF1154.2
007600 04 CORRECT-18V0 PIC -9(18). IF1154.2
007700 04 FILLER PIC X. IF1154.2
007800 03 FILLER PIC X(2) VALUE SPACE. IF1154.2
007900 03 COR-ANSI-REFERENCE PIC X(48) VALUE SPACE. IF1154.2
008000 01 CCVS-C-1. IF1154.2
008100 02 FILLER PIC IS X(99) VALUE IS " FEATURE PAIF1154.2
008200- "SS PARAGRAPH-NAME IF1154.2
008300- " REMARKS". IF1154.2
008400 02 FILLER PIC X(20) VALUE SPACE. IF1154.2
008500 01 CCVS-C-2. IF1154.2
008600 02 FILLER PIC X VALUE SPACE. IF1154.2
008700 02 FILLER PIC X(6) VALUE "TESTED". IF1154.2
008800 02 FILLER PIC X(15) VALUE SPACE. IF1154.2
008900 02 FILLER PIC X(4) VALUE "FAIL". IF1154.2
009000 02 FILLER PIC X(94) VALUE SPACE. IF1154.2
009100 01 REC-SKL-SUB PIC 9(2) VALUE ZERO. IF1154.2
009200 01 REC-CT PIC 99 VALUE ZERO. IF1154.2
009300 01 DELETE-COUNTER PIC 999 VALUE ZERO. IF1154.2
009400 01 ERROR-COUNTER PIC 999 VALUE ZERO. IF1154.2
009500 01 INSPECT-COUNTER PIC 999 VALUE ZERO. IF1154.2
009600 01 PASS-COUNTER PIC 999 VALUE ZERO. IF1154.2
009700 01 TOTAL-ERROR PIC 999 VALUE ZERO. IF1154.2
009800 01 ERROR-HOLD PIC 999 VALUE ZERO. IF1154.2
009900 01 DUMMY-HOLD PIC X(120) VALUE SPACE. IF1154.2
010000 01 RECORD-COUNT PIC 9(5) VALUE ZERO. IF1154.2
010100 01 ANSI-REFERENCE PIC X(48) VALUE SPACES. IF1154.2
010200 01 CCVS-H-1. IF1154.2
010300 02 FILLER PIC X(39) VALUE SPACES. IF1154.2
010400 02 FILLER PIC X(42) VALUE IF1154.2
010500 "OFFICIAL COBOL COMPILER VALIDATION SYSTEM". IF1154.2
010600 02 FILLER PIC X(39) VALUE SPACES. IF1154.2
010700 01 CCVS-H-2A. IF1154.2
010800 02 FILLER PIC X(40) VALUE SPACE. IF1154.2
010900 02 FILLER PIC X(7) VALUE "CCVS85 ". IF1154.2
011000 02 FILLER PIC XXXX VALUE IF1154.2
011100 "4.2 ". IF1154.2
011200 02 FILLER PIC X(28) VALUE IF1154.2
011300 " COPY - NOT FOR DISTRIBUTION". IF1154.2
011400 02 FILLER PIC X(41) VALUE SPACE. IF1154.2
011500 IF1154.2
011600 01 CCVS-H-2B. IF1154.2
011700 02 FILLER PIC X(15) VALUE IF1154.2
011800 "TEST RESULT OF ". IF1154.2
011900 02 TEST-ID PIC X(9). IF1154.2
012000 02 FILLER PIC X(4) VALUE IF1154.2
012100 " IN ". IF1154.2
012200 02 FILLER PIC X(12) VALUE IF1154.2
012300 " HIGH ". IF1154.2
012400 02 FILLER PIC X(22) VALUE IF1154.2
012500 " LEVEL VALIDATION FOR ". IF1154.2
012600 02 FILLER PIC X(58) VALUE IF1154.2
012700 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1154.2
012800 01 CCVS-H-3. IF1154.2
012900 02 FILLER PIC X(34) VALUE IF1154.2
013000 " FOR OFFICIAL USE ONLY ". IF1154.2
013100 02 FILLER PIC X(58) VALUE IF1154.2
013200 "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".IF1154.2
013300 02 FILLER PIC X(28) VALUE IF1154.2
013400 " COPYRIGHT 1985 ". IF1154.2
013500 01 CCVS-E-1. IF1154.2
013600 02 FILLER PIC X(52) VALUE SPACE. IF1154.2
013700 02 FILLER PIC X(14) VALUE IS "END OF TEST- ". IF1154.2
013800 02 ID-AGAIN PIC X(9). IF1154.2
013900 02 FILLER PIC X(45) VALUE SPACES. IF1154.2
014000 01 CCVS-E-2. IF1154.2
014100 02 FILLER PIC X(31) VALUE SPACE. IF1154.2
014200 02 FILLER PIC X(21) VALUE SPACE. IF1154.2
014300 02 CCVS-E-2-2. IF1154.2
014400 03 ERROR-TOTAL PIC XXX VALUE SPACE. IF1154.2
014500 03 FILLER PIC X VALUE SPACE. IF1154.2
014600 03 ENDER-DESC PIC X(44) VALUE IF1154.2
014700 "ERRORS ENCOUNTERED". IF1154.2
014800 01 CCVS-E-3. IF1154.2
014900 02 FILLER PIC X(22) VALUE IF1154.2
015000 " FOR OFFICIAL USE ONLY". IF1154.2
015100 02 FILLER PIC X(12) VALUE SPACE. IF1154.2
015200 02 FILLER PIC X(58) VALUE IF1154.2
015300 "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".IF1154.2
015400 02 FILLER PIC X(13) VALUE SPACE. IF1154.2
015500 02 FILLER PIC X(15) VALUE IF1154.2
015600 " COPYRIGHT 1985". IF1154.2
015700 01 CCVS-E-4. IF1154.2
015800 02 CCVS-E-4-1 PIC XXX VALUE SPACE. IF1154.2
015900 02 FILLER PIC X(4) VALUE " OF ". IF1154.2
016000 02 CCVS-E-4-2 PIC XXX VALUE SPACE. IF1154.2
016100 02 FILLER PIC X(40) VALUE IF1154.2
016200 " TESTS WERE EXECUTED SUCCESSFULLY". IF1154.2
016300 01 XXINFO. IF1154.2
016400 02 FILLER PIC X(19) VALUE IF1154.2
016500 "*** INFORMATION ***". IF1154.2
016600 02 INFO-TEXT. IF1154.2
016700 04 FILLER PIC X(8) VALUE SPACE. IF1154.2
016800 04 XXCOMPUTED PIC X(20). IF1154.2
016900 04 FILLER PIC X(5) VALUE SPACE. IF1154.2
017000 04 XXCORRECT PIC X(20). IF1154.2
017100 02 INF-ANSI-REFERENCE PIC X(48). IF1154.2
017200 01 HYPHEN-LINE. IF1154.2
017300 02 FILLER PIC IS X VALUE IS SPACE. IF1154.2
017400 02 FILLER PIC IS X(65) VALUE IS "************************IF1154.2
017500- "*****************************************". IF1154.2
017600 02 FILLER PIC IS X(54) VALUE IS "************************IF1154.2
017700- "******************************". IF1154.2
017800 01 CCVS-PGM-ID PIC X(9) VALUE IF1154.2
017900 "IF115A". IF1154.2
018000 PROCEDURE DIVISION. IF1154.2
018100 CCVS1 SECTION. IF1154.2
018200 OPEN-FILES. IF1154.2
018300 OPEN OUTPUT PRINT-FILE. IF1154.2
018400 MOVE CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN. IF1154.2
018500 MOVE SPACE TO TEST-RESULTS. IF1154.2
018600 PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE. IF1154.2
018700 GO TO CCVS1-EXIT. IF1154.2
018800 CLOSE-FILES. IF1154.2
018900 PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE. IF1154.2
019000 TERMINATE-CCVS. IF1154.2
019100 STOP RUN. IF1154.2
019200 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER. IF1154.2
019300 PASS. MOVE "PASS " TO P-OR-F. ADD 1 TO PASS-COUNTER. IF1154.2
019400 FAIL. MOVE "FAIL*" TO P-OR-F. ADD 1 TO ERROR-COUNTER. IF1154.2
019500 DE-LETE. MOVE "*****" TO P-OR-F. ADD 1 TO DELETE-COUNTER. IF1154.2
019600 MOVE "****TEST DELETED****" TO RE-MARK. IF1154.2
019700 PRINT-DETAIL. IF1154.2
019800 IF REC-CT NOT EQUAL TO ZERO IF1154.2
019900 MOVE "." TO PARDOT-X IF1154.2
020000 MOVE REC-CT TO DOTVALUE. IF1154.2
020100 MOVE TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE. IF1154.2
020200 IF P-OR-F EQUAL TO "FAIL*" PERFORM WRITE-LINE IF1154.2
020300 PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX IF1154.2
020400 ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX. IF1154.2
020500 MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X. IF1154.2
020600 MOVE SPACE TO CORRECT-X. IF1154.2
020700 IF REC-CT EQUAL TO ZERO MOVE SPACE TO PAR-NAME. IF1154.2
020800 MOVE SPACE TO RE-MARK. IF1154.2
020900 HEAD-ROUTINE. IF1154.2
021000 MOVE CCVS-H-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1154.2
021100 MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1154.2
021200 MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1154.2
021300 MOVE CCVS-H-3 TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES. IF1154.2
021400 COLUMN-NAMES-ROUTINE. IF1154.2
021500 MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1154.2
021600 MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1154.2
021700 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1154.2
021800 END-ROUTINE. IF1154.2
021900 MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.IF1154.2
022000 END-RTN-EXIT. IF1154.2
022100 MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1154.2
022200 END-ROUTINE-1. IF1154.2
022300 ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO IF1154.2
022400 ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD. IF1154.2
022500 ADD PASS-COUNTER TO ERROR-HOLD. IF1154.2
022600 MOVE PASS-COUNTER TO CCVS-E-4-1. IF1154.2
022700 MOVE ERROR-HOLD TO CCVS-E-4-2. IF1154.2
022800 MOVE CCVS-E-4 TO CCVS-E-2-2. IF1154.2
022900 MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE. IF1154.2
023000 END-ROUTINE-12. IF1154.2
023100 MOVE "TEST(S) FAILED" TO ENDER-DESC. IF1154.2
023200 IF ERROR-COUNTER IS EQUAL TO ZERO IF1154.2
023300 MOVE "NO " TO ERROR-TOTAL IF1154.2
023400 ELSE IF1154.2
023500 MOVE ERROR-COUNTER TO ERROR-TOTAL. IF1154.2
023600 MOVE CCVS-E-2 TO DUMMY-RECORD. IF1154.2
023700 PERFORM WRITE-LINE. IF1154.2
023800 END-ROUTINE-13. IF1154.2
023900 IF DELETE-COUNTER IS EQUAL TO ZERO IF1154.2
024000 MOVE "NO " TO ERROR-TOTAL ELSE IF1154.2
024100 MOVE DELETE-COUNTER TO ERROR-TOTAL. IF1154.2
024200 MOVE "TEST(S) DELETED " TO ENDER-DESC. IF1154.2
024300 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1154.2
024400 IF INSPECT-COUNTER EQUAL TO ZERO IF1154.2
024500 MOVE "NO " TO ERROR-TOTAL IF1154.2
024600 ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL. IF1154.2
024700 MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC. IF1154.2
024800 MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1154.2
024900 MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE. IF1154.2
025000 WRITE-LINE. IF1154.2
025100 ADD 1 TO RECORD-COUNT. IF1154.2
025200 IF RECORD-COUNT GREATER 42 IF1154.2
025300 MOVE DUMMY-RECORD TO DUMMY-HOLD IF1154.2
025400 MOVE SPACE TO DUMMY-RECORD IF1154.2
025500 WRITE DUMMY-RECORD AFTER ADVANCING PAGE IF1154.2
025600 MOVE CCVS-H-1 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1154.2
025700 MOVE CCVS-H-2A TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES IF1154.2
025800 MOVE CCVS-H-2B TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1154.2
025900 MOVE CCVS-H-3 TO DUMMY-RECORD PERFORM WRT-LN 3 TIMES IF1154.2
026000 MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN IF1154.2
026100 MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN IF1154.2
026200 MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN IF1154.2
026300 MOVE DUMMY-HOLD TO DUMMY-RECORD IF1154.2
026400 MOVE ZERO TO RECORD-COUNT. IF1154.2
026500 PERFORM WRT-LN. IF1154.2
026600 WRT-LN. IF1154.2
026700 WRITE DUMMY-RECORD AFTER ADVANCING 1 LINES. IF1154.2
026800 MOVE SPACE TO DUMMY-RECORD. IF1154.2
026900 BLANK-LINE-PRINT. IF1154.2
027000 PERFORM WRT-LN. IF1154.2
027100 FAIL-ROUTINE. IF1154.2
027200 IF COMPUTED-X NOT EQUAL TO SPACE IF1154.2
027300 GO TO FAIL-ROUTINE-WRITE. IF1154.2
027400 IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.IF1154.2
027500 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1154.2
027600 MOVE "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT. IF1154.2
027700 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1154.2
027800 MOVE SPACES TO INF-ANSI-REFERENCE. IF1154.2
027900 GO TO FAIL-ROUTINE-EX. IF1154.2
028000 FAIL-ROUTINE-WRITE. IF1154.2
028100 MOVE TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE IF1154.2
028200 MOVE ANSI-REFERENCE TO COR-ANSI-REFERENCE. IF1154.2
028300 MOVE TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. IF1154.2
028400 MOVE SPACES TO COR-ANSI-REFERENCE. IF1154.2
028500 FAIL-ROUTINE-EX. EXIT. IF1154.2
028600 BAIL-OUT. IF1154.2
028700 IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE. IF1154.2
028800 IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX. IF1154.2
028900 BAIL-OUT-WRITE. IF1154.2
029000 MOVE CORRECT-A TO XXCORRECT. IF1154.2
029100 MOVE COMPUTED-A TO XXCOMPUTED. IF1154.2
029200 MOVE ANSI-REFERENCE TO INF-ANSI-REFERENCE. IF1154.2
029300 MOVE XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES. IF1154.2
029400 MOVE SPACES TO INF-ANSI-REFERENCE. IF1154.2
029500 BAIL-OUT-EX. EXIT. IF1154.2
029600 CCVS1-EXIT. IF1154.2
029700 EXIT. IF1154.2
029800******************************************************** IF1154.2
029900* * IF1154.2
030000* Intrinsic Function Tests IF115A - LENGTH * IF1154.2
030100* * IF1154.2
030200******************************************************** IF1154.2
030300 SECT-IF115A SECTION. IF1154.2
030400 F-LENGTH-INFO. IF1154.2
030500 MOVE "See ref. A-48 2.19" TO ANSI-REFERENCE. IF1154.2
030600 MOVE "LENGTH Function" TO FEATURE. IF1154.2
030700*****************TEST (a) ****************************** IF1154.2
030800 F-LENGTH-01. IF1154.2
030900 MOVE ZERO TO WS-INT. IF1154.2
031000 F-LENGTH-TEST-01. IF1154.2
031100 COMPUTE WS-INT = FUNCTION LENGTH("A"). IF1154.2
031200 IF WS-INT = 1 THEN IF1154.2
031300 PERFORM PASS IF1154.2
031400 ELSE IF1154.2
031500 MOVE 1 TO CORRECT-X IF1154.2
031600 MOVE WS-INT TO COMPUTED-A IF1154.2
031700 PERFORM FAIL. IF1154.2
031800 GO TO F-LENGTH-WRITE-01. IF1154.2
031900 F-LENGTH-DELETE-01. IF1154.2
032000 PERFORM DE-LETE. IF1154.2
032100 GO TO F-LENGTH-WRITE-01. IF1154.2
032200 F-LENGTH-WRITE-01. IF1154.2
032300 MOVE "F-LENGTH-01" TO PAR-NAME. IF1154.2
032400 PERFORM PRINT-DETAIL. IF1154.2
032500*****************TEST (b) ****************************** IF1154.2
032600 F-LENGTH-TEST-02. IF1154.2
032700 EVALUATE FUNCTION LENGTH("ABCDEFGHIJKLMNOPQRST") IF1154.2
032800 WHEN 20 IF1154.2
032900 PERFORM PASS IF1154.2
033000 GO TO F-LENGTH-WRITE-02. IF1154.2
033100 PERFORM FAIL. IF1154.2
033200 GO TO F-LENGTH-WRITE-02. IF1154.2
033300 F-LENGTH-DELETE-02. IF1154.2
033400 PERFORM DE-LETE. IF1154.2
033500 GO TO F-LENGTH-WRITE-02. IF1154.2
033600 F-LENGTH-WRITE-02. IF1154.2
033700 MOVE "F-LENGTH-02" TO PAR-NAME. IF1154.2
033800 PERFORM PRINT-DETAIL. IF1154.2
033900*****************TEST (c) ****************************** IF1154.2
034000 F-LENGTH-03. IF1154.2
034100 MOVE ZERO TO WS-INT. IF1154.2
034200 F-LENGTH-TEST-03. IF1154.2
034300 IF FUNCTION LENGTH("ABCD") = 4 THEN IF1154.2
034400 PERFORM PASS IF1154.2
034500 ELSE IF1154.2
034600 MOVE 4 TO CORRECT-X IF1154.2
034700 MOVE WS-INT TO COMPUTED-A IF1154.2
034800 PERFORM FAIL. IF1154.2
034900 GO TO F-LENGTH-WRITE-03. IF1154.2
035000 F-LENGTH-DELETE-03. IF1154.2
035100 PERFORM DE-LETE. IF1154.2
035200 GO TO F-LENGTH-WRITE-03. IF1154.2
035300 F-LENGTH-WRITE-03. IF1154.2
035400 MOVE "F-LENGTH-03" TO PAR-NAME. IF1154.2
035500 PERFORM PRINT-DETAIL. IF1154.2
035600*****************TEST (d) ****************************** IF1154.2
035700 F-LENGTH-04. IF1154.2
035800 MOVE ZERO TO WS-INT. IF1154.2
035900 F-LENGTH-TEST-04. IF1154.2
036000 COMPUTE WS-INT = FUNCTION LENGTH(K). IF1154.2
036100 IF WS-INT = 1 THEN IF1154.2
036200 PERFORM PASS IF1154.2
036300 ELSE IF1154.2
036400 MOVE 1 TO CORRECT-X IF1154.2
036500 MOVE WS-INT TO COMPUTED-A IF1154.2
036600 PERFORM FAIL. IF1154.2
036700 GO TO F-LENGTH-WRITE-04. IF1154.2
036800 F-LENGTH-DELETE-04. IF1154.2
036900 PERFORM DE-LETE. IF1154.2
037000 GO TO F-LENGTH-WRITE-04. IF1154.2
037100 F-LENGTH-WRITE-04. IF1154.2
037200 MOVE "F-LENGTH-04" TO PAR-NAME. IF1154.2
037300 PERFORM PRINT-DETAIL. IF1154.2
037400*****************TEST (e) ****************************** IF1154.2
037500 F-LENGTH-05. IF1154.2
037600 MOVE ZERO TO WS-INT. IF1154.2
037700 F-LENGTH-TEST-05. IF1154.2
037800 COMPUTE WS-INT = FUNCTION LENGTH(M). IF1154.2
037900 IF WS-INT = 17 THEN IF1154.2
038000 PERFORM PASS IF1154.2
038100 ELSE IF1154.2
038200 MOVE 17 TO CORRECT-X IF1154.2
038300 MOVE WS-INT TO COMPUTED-A IF1154.2
038400 PERFORM FAIL. IF1154.2
038500 GO TO F-LENGTH-WRITE-05. IF1154.2
038600 F-LENGTH-DELETE-05. IF1154.2
038700 PERFORM DE-LETE. IF1154.2
038800 GO TO F-LENGTH-WRITE-05. IF1154.2
038900 F-LENGTH-WRITE-05. IF1154.2
039000 MOVE "F-LENGTH-05" TO PAR-NAME. IF1154.2
039100 PERFORM PRINT-DETAIL. IF1154.2
039200*****************TEST (f) ****************************** IF1154.2
039300 F-LENGTH-06. IF1154.2
039400 MOVE ZERO TO WS-INT. IF1154.2
039500 F-LENGTH-TEST-06. IF1154.2
039600 COMPUTE WS-INT = FUNCTION LENGTH(N). IF1154.2
039700 IF WS-INT = 3 THEN IF1154.2
039800 PERFORM PASS IF1154.2
039900 ELSE IF1154.2
040000 MOVE 3 TO CORRECT-X IF1154.2
040100 MOVE WS-INT TO COMPUTED-A IF1154.2
040200 PERFORM FAIL. IF1154.2
040300 GO TO F-LENGTH-WRITE-06. IF1154.2
040400 F-LENGTH-DELETE-06. IF1154.2
040500 PERFORM DE-LETE. IF1154.2
040600 GO TO F-LENGTH-WRITE-06. IF1154.2
040700 F-LENGTH-WRITE-06. IF1154.2
040800 MOVE "F-LENGTH-06" TO PAR-NAME. IF1154.2
040900 PERFORM PRINT-DETAIL. IF1154.2
041000*****************TEST (g) ****************************** IF1154.2
041100 F-LENGTH-07. IF1154.2
041200 MOVE ZERO TO WS-INT. IF1154.2
041300 F-LENGTH-TEST-07. IF1154.2
041400 COMPUTE WS-INT = FUNCTION LENGTH(N) + 2. IF1154.2
041500 IF WS-INT = 5 THEN IF1154.2
041600 PERFORM PASS IF1154.2
041700 ELSE IF1154.2
041800 MOVE 5 TO CORRECT-N IF1154.2
041900 MOVE WS-INT TO COMPUTED-A IF1154.2
042000 PERFORM FAIL. IF1154.2
042100 GO TO F-LENGTH-WRITE-07. IF1154.2
042200 F-LENGTH-DELETE-07. IF1154.2
042300 PERFORM DE-LETE. IF1154.2
042400 GO TO F-LENGTH-WRITE-07. IF1154.2
042500 F-LENGTH-WRITE-07. IF1154.2
042600 MOVE "F-LENGTH-07" TO PAR-NAME. IF1154.2
042700 PERFORM PRINT-DETAIL. IF1154.2
042800*****************TEST (h) ****************************** IF1154.2
042900 F-LENGTH-08. IF1154.2
043000 MOVE ZERO TO WS-INT. IF1154.2
043100 F-LENGTH-TEST-08. IF1154.2
043200 COMPUTE WS-INT = FUNCTION LENGTH(N) + IF1154.2
043300 FUNCTION LENGTH(N). IF1154.2
043400 IF WS-INT = 6 THEN IF1154.2
043500 PERFORM PASS IF1154.2
043600 ELSE IF1154.2
043700 MOVE 6 TO CORRECT-N IF1154.2
043800 MOVE WS-INT TO COMPUTED-A IF1154.2
043900 PERFORM FAIL. IF1154.2
044000 GO TO F-LENGTH-WRITE-08. IF1154.2
044100 F-LENGTH-DELETE-08. IF1154.2
044200 PERFORM DE-LETE. IF1154.2
044300 GO TO F-LENGTH-WRITE-08. IF1154.2
044400 F-LENGTH-WRITE-08. IF1154.2
044500 MOVE "F-LENGTH-08" TO PAR-NAME. IF1154.2
044600 PERFORM PRINT-DETAIL. IF1154.2
044700*******************END OF TESTS************************** IF1154.2
044800 CCVS-EXIT SECTION. IF1154.2
044900 CCVS-999999. IF1154.2
045000 GO TO CLOSE-FILES. IF1154.2
¤ Dauer der Verarbeitung: 0.13 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.
|
