products/sources/formale Sprachen/Cobol/Test-Suite/COBOL/IX image not shown  

Quellcode-Bibliothek

© Kompilation durch diese Firma

[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]

Datei: rl211a.cob   Sprache: Cobol

000100 IDENTIFICATION DIVISION.                                         RL2114.2
000200 PROGRAM-ID.                                                      RL2114.2
000300     RL211A.                                                      RL2114.2
000400****************************************************************  RL2114.2
000500*                                                              *  RL2114.2
000600*    VALIDATION FOR:-                                          *  RL2114.2
000700*                                                              *  RL2114.2
000800*    "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH.     ".RL2114.2
000900*                                                              *  RL2114.2
001000*    "COBOL 85 VERSION 4.2, Apr  1993 SSVG                      ".RL2114.2
001100*                                                              *  RL2114.2
001200****************************************************************  RL2114.2
001300*    THE FUNCTION OF THIS PROGRAM IS TO CREATE A RELATIVE FILE *  RL2114.2
001400*    SEQUENTIALLY WITH VARIABLE LENGTH RECORDS AND VERIFY THAT *  RL2114.2
001500*    IT WAS CREATED CORRECTLY.                                 *  RL2114.2
001600*    THE PROGRAM WILL CREATE A RELATIVE FILE OF 500 VARIABLE   *  RL2114.2
001700*    LENGTH RECORDS.                                           *  RL2114.2
001800*    THE RECORD SIZE WILL BE 120 TO 140 CHARACTERS.            *  RL2114.2
001900*                                                                 RL2114.2
002000*            X-CARD PARAMETERS WHICH MUST BE SUPPLIED FOR THIS    RL2114.2
002100*            PROGRAM ARE:                                         RL2114.2
002200*                                                                 RL2114.2
002300*                 X-21   IMPLEMENTOR-NAME IN ASSIGN TO CLAUSE FOR RL2114.2
002400*                         RELATIVE  I-O DATA FILE                 RL2114.2
002500*                 X-55   SYSTEM PRINTER                           RL2114.2
002600*                 X-69   ADDITIONAL VALUE OF CLAUSES              RL2114.2
002700*                 X-74   VALUE OF IMPLEMENTOR-NAME                RL2114.2
002800*                 X-75   OBJECT OF VALUE OF CLAUSE                RL2114.2
002900*                 X-82   SOURCE-COMPUTER                          RL2114.2
003000*                 X-83   OBJECT-COMPUTER.                         RL2114.2
003100*                                                                 RL2114.2
003200****************************************************************  RL2114.2
003300 ENVIRONMENT DIVISION.                                            RL2114.2
003400 CONFIGURATION SECTION.                                           RL2114.2
003500 SOURCE-COMPUTER.                                                 RL2114.2
003600     Card0130.                                                    RL2114.2
003700 OBJECT-COMPUTER.                                                 RL2114.2
003800     Card0131.                                                    RL2114.2
003900 INPUT-OUTPUT SECTION.                                            RL2114.2
004000 FILE-CONTROL.                                                    RL2114.2
004100     SELECT PRINT-FILE ASSIGN TO                                  RL2114.2
004200     "C0085" .                                                    RL2114.2
004300     SELECT   RL-VS1 ASSIGN TO                                    RL2114.2
004400     XXXXP021                                                     RL2114.2
004500             ORGANIZATION IS RELATIVE.                            RL2114.2
004600*    ABSENCE OF THE ACCESS CLAUSE IS TREATED AS THOUGH            RL2114.2
004700*     SEQUENTIAL HAD BEEN SPECIFIED.                              RL2114.2
004800 DATA DIVISION.                                                   RL2114.2
004900 FILE SECTION.                                                    RL2114.2
005000 FD  PRINT-FILE.                                                  RL2114.2
005100 01  PRINT-REC PICTURE X(120).                                    RL2114.2
005200 01  DUMMY-RECORD PICTURE X(120).                                 RL2114.2
005300 FD  RL-VS1                                                       RL2114.2
005400     LABEL RECORDS STANDARD                                       RL2114.2
005500     VALUE OF                                                     RL2114.2
005600     Impl1                                                        RL2114.2
005700     IS                                                           RL2114.2
005800     4711                                                         RL2114.2
005900                                                                  RL2114.2
006000     BLOCK CONTAINS 1 RECORDS                                     RL2114.2
006100     RECORD IS VARYING.                                           RL2114.2
006200 01  RL-VS1R1-F-G-140.                                            RL2114.2
006300     02  FILLER PIC X.                                            RL2114.2
006400     02  FILLER PIC X(7).                                         RL2114.2
006500     02  FILLER PIC X(108).                                       RL2114.2
006600     02  RL-VS1R1-F-G-117-119  PIC 9(3).                          RL2114.2
006700     02  RL-GROUP.                                                RL2114.2
006800      03 RL-VS1R1-F-G-120-140  PIC X  OCCURS 1 TO 21              RL2114.2
006900                               DEPENDING ON RL-VS1R1-F-G-117-119. RL2114.2
007000 WORKING-STORAGE SECTION.                                         RL2114.2
007100 01  WS-VS1R1-F-G-140.                                            RL2114.2
007200     02  FILLER PIC X(116).                                       RL2114.2
007300     02  WS-VS1R1-F-G-117-119  PIC 9(3).                          RL2114.2
007400     02  WS-VS1R1-F-G-120-140  PIC X(21).                         RL2114.2
007500 01  WRK-CS-09V00 PIC S9(9) USAGE COMP VALUE ZERO.                RL2114.2
007600 01  FILE-RECORD-INFORMATION-REC.                                 RL2114.2
007700     03 FILE-RECORD-INFO-SKELETON.                                RL2114.2
007800        05 FILLER                 PICTURE X(48)       VALUE       RL2114.2
007900             "FILE= ,RECORD= /0,RECNO=000000,UPDT=00".  RL2114.2
008000        05 FILLER                 PICTURE X(46)       VALUE       RL2114.2
008100             ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000".    RL2114.2
008200        05 FILLER                 PICTURE X(26)       VALUE       RL2114.2
008300             ",LFIL=000000,ORG= ,LBLR= ".                        RL2114.2
008400        05 FILLER                 PICTURE X(37)       VALUE       RL2114.2
008500             ",RECKEY= ".             RL2114.2
008600        05 FILLER                 PICTURE X(38)       VALUE       RL2114.2
008700             ",ALTKEY1= ".            RL2114.2
008800        05 FILLER                 PICTURE X(38)       VALUE       RL2114.2
008900             ",ALTKEY2= ".            RL2114.2
009000        05 FILLER                 PICTURE X(7)        VALUE SPACE.RL2114.2
009100     03 FILE-RECORD-INFO          OCCURS  10  TIMES.              RL2114.2
009200        05 FILE-RECORD-INFO-P1-120.                               RL2114.2
009300           07 FILLER              PIC X(5).                       RL2114.2
009400           07 XFILE-NAME           PIC X(6).                      RL2114.2
009500           07 FILLER              PIC X(8).                       RL2114.2
009600           07 XRECORD-NAME         PIC X(6).                      RL2114.2
009700           07 FILLER              PIC X(1).                       RL2114.2
009800           07 REELUNIT-NUMBER     PIC 9(1).                       RL2114.2
009900           07 FILLER              PIC X(7).                       RL2114.2
010000           07 XRECORD-NUMBER       PIC 9(6).                      RL2114.2
010100           07 FILLER              PIC X(6).                       RL2114.2
010200           07 UPDATE-NUMBER       PIC 9(2).                       RL2114.2
010300           07 FILLER              PIC X(5).                       RL2114.2
010400           07 ODO-NUMBER          PIC 9(4).                       RL2114.2
010500           07 FILLER              PIC X(5).                       RL2114.2
010600           07 XPROGRAM-NAME        PIC X(5).                      RL2114.2
010700           07 FILLER              PIC X(7).                       RL2114.2
010800           07 XRECORD-LENGTH       PIC 9(6).                      RL2114.2
010900           07 FILLER              PIC X(7).                       RL2114.2
011000           07 CHARS-OR-RECORDS    PIC X(2).                       RL2114.2
011100           07 FILLER              PIC X(1).                       RL2114.2
011200           07 XBLOCK-SIZE          PIC 9(4).                      RL2114.2
011300           07 FILLER              PIC X(6).                       RL2114.2
011400           07 RECORDS-IN-FILE     PIC 9(6).                       RL2114.2
011500           07 FILLER              PIC X(5).                       RL2114.2
011600           07 XFILE-ORGANIZATION   PIC X(2).                      RL2114.2
011700           07 FILLER              PIC X(6).                       RL2114.2
011800           07 XLABEL-TYPE          PIC X(1).                      RL2114.2
011900        05 FILE-RECORD-INFO-P121-240.                             RL2114.2
012000           07 FILLER              PIC X(8).                       RL2114.2
012100           07 XRECORD-KEY          PIC X(29).                     RL2114.2
012200           07 FILLER              PIC X(9).                       RL2114.2
012300           07 ALTERNATE-KEY1      PIC X(29).                      RL2114.2
012400           07 FILLER              PIC X(9).                       RL2114.2
012500           07 ALTERNATE-KEY2      PIC X(29).                      RL2114.2
012600           07 FILLER              PIC X(7).                       RL2114.2
012700 01  TEST-RESULTS.                                                RL2114.2
012800     02 FILLER                   PIC X      VALUE SPACE.          RL2114.2
012900     02 FEATURE                  PIC X(20)  VALUE SPACE.          RL2114.2
013000     02 FILLER                   PIC X      VALUE SPACE.          RL2114.2
013100     02 P-OR-F                   PIC X(5)   VALUE SPACE.          RL2114.2
013200     02 FILLER                   PIC X      VALUE SPACE.          RL2114.2
013300     02  PAR-NAME.                                                RL2114.2
013400       03 FILLER                 PIC X(19)  VALUE SPACE.          RL2114.2
013500       03  PARDOT-X              PIC X      VALUE SPACE.          RL2114.2
013600       03 DOTVALUE               PIC 99     VALUE ZERO.           RL2114.2
013700     02 FILLER                   PIC X(8)   VALUE SPACE.          RL2114.2
013800     02 RE-MARK                  PIC X(61).                       RL2114.2
013900 01  TEST-COMPUTED.                                               RL2114.2
014000     02 FILLER                   PIC X(30)  VALUE SPACE.          RL2114.2
014100     02 FILLER                   PIC X(17)  VALUE                 RL2114.2
014200            " COMPUTED=".                                   RL2114.2
014300     02 COMPUTED-X.                                               RL2114.2
014400     03 COMPUTED-A               PIC X(20)  VALUE SPACE.          RL2114.2
014500     03 COMPUTED-N               REDEFINES COMPUTED-A             RL2114.2
014600                                 PIC -9(9).9(9).                  RL2114.2
014700     03 COMPUTED-0V18 REDEFINES COMPUTED-A   PIC -.9(18).         RL2114.2
014800     03 COMPUTED-4V14 REDEFINES COMPUTED-A   PIC -9(4).9(14).     RL2114.2
014900     03 COMPUTED-14V4 REDEFINES COMPUTED-A   PIC -9(14).9(4).     RL2114.2
015000     03       CM-18V0 REDEFINES COMPUTED-A.                       RL2114.2
015100         04 COMPUTED-18V0                    PIC -9(18).          RL2114.2
015200         04 FILLER                           PIC X.               RL2114.2
015300     03 FILLER PIC X(50) VALUE SPACE.                             RL2114.2
015400 01  TEST-CORRECT.                                                RL2114.2
015500     02 FILLER PIC X(30) VALUE SPACE.                             RL2114.2
015600     02 FILLER PIC X(17) VALUE " CORRECT =".                RL2114.2
015700     02 CORRECT-X.                                                RL2114.2
015800     03 CORRECT-A                  PIC X(20) VALUE SPACE.         RL2114.2
015900     03 CORRECT-N    REDEFINES CORRECT-A     PIC -9(9).9(9).      RL2114.2
016000     03 CORRECT-0V18 REDEFINES CORRECT-A     PIC -.9(18).         RL2114.2
016100     03 CORRECT-4V14 REDEFINES CORRECT-A     PIC -9(4).9(14).     RL2114.2
016200     03 CORRECT-14V4 REDEFINES CORRECT-A     PIC -9(14).9(4).     RL2114.2
016300     03      CR-18V0 REDEFINES CORRECT-A.                         RL2114.2
016400         04 CORRECT-18V0                     PIC -9(18).          RL2114.2
016500         04 FILLER                           PIC X.               RL2114.2
016600     03 FILLER PIC X(2) VALUE SPACE.                              RL2114.2
016700     03 COR-ANSI-REFERENCE             PIC X(48) VALUE SPACE.     RL2114.2
016800 01  CCVS-C-1.                                                    RL2114.2
016900     02 FILLER  PIC IS X(99)    VALUE IS " FEATURE PARL2114.2
017000-    "SS PARAGRAPH-NAME RL2114.2
017100-    " REMARKS".                                            RL2114.2
017200     02 FILLER                     PIC X(20)    VALUE SPACE.      RL2114.2
017300 01  CCVS-C-2.                                                    RL2114.2
017400     02 FILLER                     PIC X        VALUE SPACE.      RL2114.2
017500     02 FILLER                     PIC X(6)     VALUE "TESTED".   RL2114.2
017600     02 FILLER                     PIC X(15)    VALUE SPACE.      RL2114.2
017700     02 FILLER                     PIC X(4)     VALUE "FAIL".     RL2114.2
017800     02 FILLER                     PIC X(94)    VALUE SPACE.      RL2114.2
017900 01  REC-SKL-SUB                   PIC 9(2)     VALUE ZERO.       RL2114.2
018000 01  REC-CT                        PIC 99       VALUE ZERO.       RL2114.2
018100 01  DELETE-COUNTER                PIC 999      VALUE ZERO.       RL2114.2
018200 01  ERROR-COUNTER                 PIC 999      VALUE ZERO.       RL2114.2
018300 01  INSPECT-COUNTER               PIC 999      VALUE ZERO.       RL2114.2
018400 01  PASS-COUNTER                  PIC 999      VALUE ZERO.       RL2114.2
018500 01  TOTAL-ERROR                   PIC 999      VALUE ZERO.       RL2114.2
018600 01  ERROR-HOLD                    PIC 999      VALUE ZERO.       RL2114.2
018700 01  DUMMY-HOLD                    PIC X(120)   VALUE SPACE.      RL2114.2
018800 01  RECORD-COUNT                  PIC 9(5)     VALUE ZERO.       RL2114.2
018900 01  ANSI-REFERENCE                PIC X(48)    VALUE SPACES.     RL2114.2
019000 01  CCVS-H-1.                                                    RL2114.2
019100     02  FILLER                    PIC X(39)    VALUE SPACES.     RL2114.2
019200     02  FILLER                    PIC X(42)    VALUE             RL2114.2
019300     "OFFICIAL COBOL COMPILER VALIDATION SYSTEM".                 RL2114.2
019400     02  FILLER                    PIC X(39)    VALUE SPACES.     RL2114.2
019500 01  CCVS-H-2A.                                                   RL2114.2
019600   02  FILLER                        PIC X(40)  VALUE SPACE.      RL2114.2
019700   02  FILLER                        PIC X(7)   VALUE "CCVS85 ".  RL2114.2
019800   02  FILLER                        PIC XXXX   VALUE             RL2114.2
019900     "4.2 ".                                                      RL2114.2
020000   02  FILLER                        PIC X(28)  VALUE             RL2114.2
020100            " COPY - NOT FOR DISTRIBUTION".                       RL2114.2
020200   02  FILLER                        PIC X(41)  VALUE SPACE.      RL2114.2
020300                                                                  RL2114.2
020400 01  CCVS-H-2B.                                                   RL2114.2
020500   02  FILLER                        PIC X(15)  VALUE             RL2114.2
020600            "TEST RESULT OF ".                                    RL2114.2
020700   02  TEST-ID                       PIC X(9).                    RL2114.2
020800   02  FILLER                        PIC X(4)   VALUE             RL2114.2
020900            " IN ".                                               RL2114.2
021000   02  FILLER                        PIC X(12)  VALUE             RL2114.2
021100     " HIGH ".                                              RL2114.2
021200   02  FILLER                        PIC X(22)  VALUE             RL2114.2
021300            " LEVEL VALIDATION FOR ".                             RL2114.2
021400   02  FILLER                        PIC X(58)  VALUE             RL2114.2
021500     "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2114.2
021600 01  CCVS-H-3.                                                    RL2114.2
021700     02  FILLER                      PIC X(34)  VALUE             RL2114.2
021800            " FOR OFFICIAL USE ONLY ".                         RL2114.2
021900     02  FILLER                      PIC X(58)  VALUE             RL2114.2
022000     "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".RL2114.2
022100     02  FILLER                      PIC X(28)  VALUE             RL2114.2
022200            " COPYRIGHT 1985 ".                                RL2114.2
022300 01  CCVS-E-1.                                                    RL2114.2
022400     02 FILLER                       PIC X(52)  VALUE SPACE.      RL2114.2
022500     02 FILLER  PIC X(14) VALUE IS "END OF TEST- ".              RL2114.2
022600     02 ID-AGAIN                     PIC X(9).                    RL2114.2
022700     02 FILLER                       PIC X(45)  VALUE SPACES.     RL2114.2
022800 01  CCVS-E-2.                                                    RL2114.2
022900     02  FILLER                      PIC X(31)  VALUE SPACE.      RL2114.2
023000     02  FILLER                      PIC X(21)  VALUE SPACE.      RL2114.2
023100     02 CCVS-E-2-2.                                               RL2114.2
023200         03 ERROR-TOTAL              PIC XXX    VALUE SPACE.      RL2114.2
023300         03 FILLER                   PIC X      VALUE SPACE.      RL2114.2
023400         03 ENDER-DESC               PIC X(44)  VALUE             RL2114.2
023500            "ERRORS ENCOUNTERED".                                 RL2114.2
023600 01  CCVS-E-3.                                                    RL2114.2
023700     02  FILLER                      PIC X(22)  VALUE             RL2114.2
023800            " FOR OFFICIAL USE ONLY".                             RL2114.2
023900     02  FILLER                      PIC X(12)  VALUE SPACE.      RL2114.2
024000     02  FILLER                      PIC X(58)  VALUE             RL2114.2
024100     "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".RL2114.2
024200     02  FILLER                      PIC X(13)  VALUE SPACE.      RL2114.2
024300     02 FILLER                       PIC X(15)  VALUE             RL2114.2
024400             " COPYRIGHT 1985".                                   RL2114.2
024500 01  CCVS-E-4.                                                    RL2114.2
024600     02 CCVS-E-4-1                   PIC XXX    VALUE SPACE.      RL2114.2
024700     02 FILLER                       PIC X(4)   VALUE " OF ".     RL2114.2
024800     02 CCVS-E-4-2                   PIC XXX    VALUE SPACE.      RL2114.2
024900     02 FILLER                       PIC X(40)  VALUE             RL2114.2
025000      " TESTS WERE EXECUTED SUCCESSFULLY".                       RL2114.2
025100 01  XXINFO.                                                      RL2114.2
025200     02 FILLER                       PIC X(19)  VALUE             RL2114.2
025300            "*** INFORMATION ***".                                RL2114.2
025400     02 INFO-TEXT.                                                RL2114.2
025500       04 FILLER                     PIC X(8)   VALUE SPACE.      RL2114.2
025600       04 XXCOMPUTED                 PIC X(20).                   RL2114.2
025700       04 FILLER                     PIC X(5)   VALUE SPACE.      RL2114.2
025800       04 XXCORRECT                  PIC X(20).                   RL2114.2
025900     02 INF-ANSI-REFERENCE           PIC X(48).                   RL2114.2
026000 01  HYPHEN-LINE.                                                 RL2114.2
026100     02 FILLER  PIC IS X VALUE IS SPACE.                          RL2114.2
026200     02 FILLER  PIC IS X(65)    VALUE IS "************************RL2114.2
026300-    "*****************************************".                 RL2114.2
026400     02 FILLER  PIC IS X(54)    VALUE IS "************************RL2114.2
026500-    "******************************".                            RL2114.2
026600 01  CCVS-PGM-ID                     PIC X(9)   VALUE             RL2114.2
026700     "RL211A".                                                    RL2114.2
026800 PROCEDURE DIVISION.                                              RL2114.2
026900 CCVS1 SECTION.                                                   RL2114.2
027000 OPEN-FILES.                                                      RL2114.2
027100     OPEN    OUTPUT PRINT-FILE.                                   RL2114.2
027200     MOVE  CCVS-PGM-ID TO TEST-ID. MOVE CCVS-PGM-ID TO ID-AGAIN.  RL2114.2
027300     MOVE    SPACE TO TEST-RESULTS.                               RL2114.2
027400     PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE.              RL2114.2
027500     MOVE    ZERO TO REC-SKL-SUB.                                 RL2114.2
027600     PERFORM CCVS-INIT-FILE 9 TIMES.                              RL2114.2
027700 CCVS-INIT-FILE.                                                  RL2114.2
027800     ADD     1 TO REC-SKL-SUB.                                    RL2114.2
027900     MOVE    FILE-RECORD-INFO-SKELETON                            RL2114.2
028000          TO FILE-RECORD-INFO (REC-SKL-SUB).                      RL2114.2
028100 CCVS-INIT-EXIT.                                                  RL2114.2
028200     GO TO CCVS1-EXIT.                                            RL2114.2
028300 CLOSE-FILES.                                                     RL2114.2
028400     PERFORM END-ROUTINE THRU END-ROUTINE-13. CLOSE PRINT-FILE.   RL2114.2
028500 TERMINATE-CCVS.                                                  RL2114.2
028600     EXIT PROGRAM.                                                RL2114.2
028700 TERMINATE-CALL.                                                  RL2114.2
028800     STOP     RUN.                                                RL2114.2
028900 INSPT. MOVE "INSPT" TO P-OR-F. ADD 1 TO INSPECT-COUNTER.         RL2114.2
029000 PASS.  MOVE "PASS " TO P-OR-F.  ADD 1 TO PASS-COUNTER.           RL2114.2
029100 FAIL.  MOVE "FAIL*" TO P-OR-F.  ADD 1 TO ERROR-COUNTER.          RL2114.2
029200 DE-LETE.  MOVE "*****" TO P-OR-F.  ADD 1 TO DELETE-COUNTER.      RL2114.2
029300     MOVE "****TEST DELETED****" TO RE-MARK.                      RL2114.2
029400 PRINT-DETAIL.                                                    RL2114.2
029500     IF REC-CT NOT EQUAL TO ZERO                                  RL2114.2
029600             MOVE "." TO PARDOT-X                                 RL2114.2
029700             MOVE REC-CT TO DOTVALUE.                             RL2114.2
029800     MOVE     TEST-RESULTS TO PRINT-REC. PERFORM WRITE-LINE.      RL2114.2
029900     IF P-OR-F EQUAL TO "FAIL*"  PERFORM WRITE-LINE               RL2114.2
030000        PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX                 RL2114.2
030100          ELSE PERFORM BAIL-OUT THRU BAIL-OUT-EX.                 RL2114.2
030200     MOVE SPACE TO P-OR-F. MOVE SPACE TO COMPUTED-X.              RL2114.2
030300     MOVE SPACE TO CORRECT-X.                                     RL2114.2
030400     IF     REC-CT EQUAL TO ZERO  MOVE SPACE TO PAR-NAME.         RL2114.2
030500     MOVE     SPACE TO RE-MARK.                                   RL2114.2
030600 HEAD-ROUTINE.                                                    RL2114.2
030700     MOVE CCVS-H-1  TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES.  RL2114.2
030800     MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES.  RL2114.2
030900     MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES.  RL2114.2
031000     MOVE CCVS-H-3  TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES.  RL2114.2
031100 COLUMN-NAMES-ROUTINE.                                            RL2114.2
031200     MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE.           RL2114.2
031300     MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES.   RL2114.2
031400     MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE.        RL2114.2
031500 END-ROUTINE.                                                     RL2114.2
031600     MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE 5 TIMES.RL2114.2
031700 END-RTN-EXIT.                                                    RL2114.2
031800     MOVE CCVS-E-1 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES.   RL2114.2
031900 END-ROUTINE-1.                                                   RL2114.2
032000      ADD ERROR-COUNTER TO ERROR-HOLD ADD INSPECT-COUNTER TO      RL2114.2
032100      ERROR-HOLD. ADD DELETE-COUNTER TO ERROR-HOLD.               RL2114.2
032200      ADD PASS-COUNTER TO ERROR-HOLD.                             RL2114.2
032300*     IF PASS-COUNTER EQUAL TO ERROR-HOLD GO TO END-ROUTINE-12.   RL2114.2
032400      MOVE PASS-COUNTER TO CCVS-E-4-1.                            RL2114.2
032500      MOVE ERROR-HOLD TO CCVS-E-4-2.                              RL2114.2
032600      MOVE CCVS-E-4 TO CCVS-E-2-2.                                RL2114.2
032700      MOVE CCVS-E-2 TO DUMMY-RECORD PERFORM WRITE-LINE.           RL2114.2
032800  END-ROUTINE-12.                                                 RL2114.2
032900      MOVE "TEST(S) FAILED" TO ENDER-DESC.                        RL2114.2
033000     IF       ERROR-COUNTER IS EQUAL TO ZERO                      RL2114.2
033100         MOVE "NO " TO ERROR-TOTAL                                RL2114.2
033200         ELSE                                                     RL2114.2
033300         MOVE ERROR-COUNTER TO ERROR-TOTAL.                       RL2114.2
033400     MOVE     CCVS-E-2 TO DUMMY-RECORD.                           RL2114.2
033500     PERFORM WRITE-LINE.                                          RL2114.2
033600 END-ROUTINE-13.                                                  RL2114.2
033700     IF DELETE-COUNTER IS EQUAL TO ZERO                           RL2114.2
033800         MOVE "NO " TO ERROR-TOTAL  ELSE                          RL2114.2
033900         MOVE DELETE-COUNTER TO ERROR-TOTAL.                      RL2114.2
034000     MOVE "TEST(S) DELETED " TO ENDER-DESC.                   RL2114.2
034100     MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE.           RL2114.2
034200      IF   INSPECT-COUNTER EQUAL TO ZERO                          RL2114.2
034300          MOVE "NO " TO ERROR-TOTAL                               RL2114.2
034400      ELSE MOVE INSPECT-COUNTER TO ERROR-TOTAL.                   RL2114.2
034500      MOVE "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC.            RL2114.2
034600      MOVE CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE.          RL2114.2
034700     MOVE CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE.           RL2114.2
034800 WRITE-LINE.                                                      RL2114.2
034900     ADD 1 TO RECORD-COUNT.                                       RL2114.2
035000     IF RECORD-COUNT GREATER 50                                   RL2114.2
035100         MOVE DUMMY-RECORD TO DUMMY-HOLD                          RL2114.2
035200         MOVE SPACE TO DUMMY-RECORD                               RL2114.2
035300         WRITE DUMMY-RECORD AFTER ADVANCING PAGE                  RL2114.2
035400         MOVE CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN             RL2114.2
035500         MOVE CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES     RL2114.2
035600         MOVE HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN          RL2114.2
035700         MOVE DUMMY-HOLD TO DUMMY-RECORD                          RL2114.2
035800         MOVE ZERO TO RECORD-COUNT.                               RL2114.2
035900     PERFORM WRT-LN.                                              RL2114.2
036000 WRT-LN.                                                          RL2114.2
036100     WRITE    DUMMY-RECORD AFTER ADVANCING 1 LINES.               RL2114.2
036200     MOVE SPACE TO DUMMY-RECORD.                                  RL2114.2
036300 BLANK-LINE-PRINT.                                                RL2114.2
036400     PERFORM WRT-LN.                                              RL2114.2
036500 FAIL-ROUTINE.                                                    RL2114.2
036600     IF     COMPUTED-X NOT EQUAL TO SPACE                         RL2114.2
036700            GO TO   FAIL-ROUTINE-WRITE.                           RL2114.2
036800     IF     CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.RL2114.2
036900     MOVE   ANSI-REFERENCE TO INF-ANSI-REFERENCE.                 RL2114.2
037000     MOVE  "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT.   RL2114.2
037100     MOVE   XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES.   RL2114.2
037200     MOVE   SPACES TO INF-ANSI-REFERENCE.                         RL2114.2
037300     GO TO  FAIL-ROUTINE-EX.                                      RL2114.2
037400 FAIL-ROUTINE-WRITE.                                              RL2114.2
037500     MOVE   TEST-COMPUTED TO PRINT-REC PERFORM WRITE-LINE         RL2114.2
037600     MOVE   ANSI-REFERENCE TO COR-ANSI-REFERENCE.                 RL2114.2
037700     MOVE   TEST-CORRECT TO PRINT-REC PERFORM WRITE-LINE 2 TIMES. RL2114.2
037800     MOVE   SPACES TO COR-ANSI-REFERENCE.                         RL2114.2
037900 FAIL-ROUTINE-EX. EXIT.                                           RL2114.2
038000 BAIL-OUT.                                                        RL2114.2
038100     IF     COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE.   RL2114.2
038200     IF     CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX.           RL2114.2
038300 BAIL-OUT-WRITE.                                                  RL2114.2
038400     MOVE CORRECT-A TO XXCORRECT. MOVE COMPUTED-A TO XXCOMPUTED.  RL2114.2
038500     MOVE   ANSI-REFERENCE TO INF-ANSI-REFERENCE.                 RL2114.2
038600     MOVE   XXINFO TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES.   RL2114.2
038700     MOVE   SPACES TO INF-ANSI-REFERENCE.                         RL2114.2
038800 BAIL-OUT-EX. EXIT.                                               RL2114.2
038900 CCVS1-EXIT.                                                      RL2114.2
039000     EXIT.                                                        RL2114.2
039100 SECT-RL211A-001 SECTION.                                         RL2114.2
039200 REL-INIT-001.                                                    RL2114.2
039300     MOVE     "FILE CREATE RL-VS1" TO FEATURE.                    RL2114.2
039400     OPEN     OUTPUT    RL-VS1.                                   RL2114.2
039500     MOVE     "RL-VS1" TO XFILE-NAME (1).                         RL2114.2
039600     MOVE     "R1-F-G" TO XRECORD-NAME (1).                       RL2114.2
039700     MOVE CCVS-PGM-ID  TO XPROGRAM-NAME (1).                      RL2114.2
039800     MOVE     000120   TO XRECORD-LENGTH (1).                     RL2114.2
039900     MOVE     "RC"     TO CHARS-OR-RECORDS (1).                   RL2114.2
040000     MOVE     0001     TO XBLOCK-SIZE (1).                        RL2114.2
040100     MOVE     000500   TO RECORDS-IN-FILE (1).                    RL2114.2
040200     MOVE     "RL"     TO XFILE-ORGANIZATION (1).                 RL2114.2
040300     MOVE     "S"      TO XLABEL-TYPE (1).                        RL2114.2
040400     MOVE     000001   TO XRECORD-NUMBER (1).                     RL2114.2
040500 REL-TEST-001.                                                    RL2114.2
040600     MOVE    FILE-RECORD-INFO-P1-120 (1) TO RL-VS1R1-F-G-140.     RL2114.2
040700     IF      XRECORD-NUMBER (1) > 32                              RL2114.2
040800             MOVE   21 TO RL-VS1R1-F-G-117-119.                   RL2114.2
040900     IF      XRECORD-NUMBER (1) = 32                              RL2114.2
041000             MOVE   16 TO RL-VS1R1-F-G-117-119.                   RL2114.2
041100     IF      XRECORD-NUMBER (1) = 31                              RL2114.2
041200             MOVE   6  TO RL-VS1R1-F-G-117-119.                   RL2114.2
041300     IF      XRECORD-NUMBER (1) < 31                              RL2114.2
041400             MOVE   21 TO RL-VS1R1-F-G-117-119.                   RL2114.2
041500     IF      XRECORD-NUMBER (1) < 21                              RL2114.2
041600             MOVE   11 TO RL-VS1R1-F-G-117-119.                   RL2114.2
041700     IF      XRECORD-NUMBER (1) < 11                              RL2114.2
041800             MOVE   1  TO RL-VS1R1-F-G-117-119.                   RL2114.2
041900     MOVE   "ABCDEFGHIJKLMNOPQRSTU" TO RL-GROUP.                  RL2114.2
042000     WRITE   RL-VS1R1-F-G-140                                     RL2114.2
042100             INVALID KEY GO TO REL-FAIL-001.                      RL2114.2
042200     IF      XRECORD-NUMBER (1) EQUAL TO 500                      RL2114.2
042300             GO TO REL-WRITE-001.                                 RL2114.2
042400     ADD     000001 TO XRECORD-NUMBER (1).                        RL2114.2
042500     GO      TO REL-TEST-001.                                     RL2114.2
042600 REL-DELETE-001.                                                  RL2114.2
042700     PERFORM DE-LETE.                                             RL2114.2
042800     GO TO REL-WRITE-001.                                         RL2114.2
042900 REL-FAIL-001.                                                    RL2114.2
043000     PERFORM FAIL.                                                RL2114.2
043100     MOVE   "BOUNDARY VIOLATION"  TO RE-MARK.                     RL2114.2
043200 REL-WRITE-001.                                                   RL2114.2
043300     MOVE   "REL-TEST-001" TO   PAR-NAME                          RL2114.2
043400     MOVE   "FILE CREATED, LFILE "  TO COMPUTED-A.                RL2114.2
043500     MOVE    XRECORD-NUMBER (1) TO CORRECT-18V0.                  RL2114.2
043600     PERFORM PRINT-DETAIL.                                        RL2114.2
043700     CLOSE   RL-VS1.                                              RL2114.2
043800     OPEN    INPUT     RL-VS1.                                    RL2114.2
043900     MOVE    ZERO      TO WRK-CS-09V00.                           RL2114.2
044000 REL-INIT-1.                                                      RL2114.2
044100     MOVE    SPACES TO RL-VS1R1-F-G-140.                          RL2114.2
044200     READ    RL-VS1                                               RL2114.2
044300             AT END GO TO REL-TEST-002-2.                         RL2114.2
044400     MOVE    RL-VS1R1-F-G-140 TO FILE-RECORD-INFO-P1-120 (1).     RL2114.2
044500     MOVE    RL-VS1R1-F-G-140 TO WS-VS1R1-F-G-140.                RL2114.2
044600     ADD     1 TO WRK-CS-09V00.                                   RL2114.2
044700     IF      WRK-CS-09V00 GREATER 500                             RL2114.2
044800             MOVE "MORE THAN 500 RECORDS" TO RE-MARK              RL2114.2
044900             GO TO REL-TEST-002-2.                                RL2114.2
045000 REL-TEST-1.                                                      RL2114.2
045100     MOVE   "VII-31 3.8.4 GR 5 & 5A" TO ANSI-REFERENCE.           RL2114.2
045200     MOVE   "REL-TEST-1" TO PAR-NAME.                             RL2114.2
045300     IF      WRK-CS-09V00 < 11                                    RL2114.2
045400             IF      WS-VS1R1-F-G-120-140 =                       RL2114.2
045500                                 "A "          RL2114.2
045600                     PERFORM PASS                                 RL2114.2
045700*                    PERFORM PRINT-DETAIL                         RL2114.2
045800             ELSE                                                 RL2114.2
045900                     MOVE    WS-VS1R1-F-G-120-140 TO COMPUTED-X   RL2114.2
046000                     MOVE   "A " TO CORRECT-X  RL2114.2
046100                     MOVE   "WRONG LENGTH RECORD" TO RE-MARK      RL2114.2
046200                     PERFORM FAIL                                 RL2114.2
046300                     PERFORM PRINT-DETAIL.                        RL2114.2
046400 REL-TEST-2.                                                      RL2114.2
046500     MOVE   "VII-31 3.8.4 GR 5" TO ANSI-REFERENCE.                RL2114.2
046600     MOVE   "REL-TEST-2" TO PAR-NAME.                             RL2114.2
046700     IF     (WRK-CS-09V00 > 10 AND < 21)                          RL2114.2
046800             IF      WS-VS1R1-F-G-120-140 =                       RL2114.2
046900                                 "ABCDEFGHIJK "          RL2114.2
047000                     PERFORM PASS                                 RL2114.2
047100*                    PERFORM PRINT-DETAIL                         RL2114.2
047200             ELSE                                                 RL2114.2
047300                     MOVE    WS-VS1R1-F-G-120-140 TO COMPUTED-X   RL2114.2
047400                     MOVE   "ABCDEFGHIJK " TO CORRECT-X  RL2114.2
047500                     MOVE   "WRONG LENGTH RECORD" TO RE-MARK      RL2114.2
047600                     PERFORM FAIL                                 RL2114.2
047700                     PERFORM PRINT-DETAIL.                        RL2114.2
047800 REL-TEST-3.                                                      RL2114.2
047900     MOVE   "VII-31 3.8.4 GR 5 & 5B" TO ANSI-REFERENCE.           RL2114.2
048000     MOVE   "REL-TEST-3" TO PAR-NAME.                             RL2114.2
048100     IF     (WRK-CS-09V00 > 20 AND < 31)                          RL2114.2
048200             IF      WS-VS1R1-F-G-120-140 =                       RL2114.2
048300                                 "ABCDEFGHIJKLMNOPQRSTU"          RL2114.2
048400                     PERFORM PASS                                 RL2114.2
048500*                    PERFORM PRINT-DETAIL                         RL2114.2
048600             ELSE                                                 RL2114.2
048700                     MOVE    WS-VS1R1-F-G-120-140 TO COMPUTED-X   RL2114.2
048800                     MOVE   "ABCDEFGHIJKLMNOPQRSTU" TO CORRECT-X  RL2114.2
048900                     MOVE   "WRONG LENGTH RECORD" TO RE-MARK      RL2114.2
049000                     PERFORM FAIL                                 RL2114.2
049100                     PERFORM PRINT-DETAIL.                        RL2114.2
049200 REL-TEST-4.                                                      RL2114.2
049300     MOVE   "VII-31 3.8.4 GR 5" TO ANSI-REFERENCE.                RL2114.2
049400     MOVE   "REL-TEST-4" TO PAR-NAME.                             RL2114.2
049500     IF      WRK-CS-09V00 = 31                                    RL2114.2
049600             IF      WS-VS1R1-F-G-120-140 =                       RL2114.2
049700                                 "ABCDEF "          RL2114.2
049800                     PERFORM PASS                                 RL2114.2
049900*                    PERFORM PRINT-DETAIL                         RL2114.2
050000             ELSE                                                 RL2114.2
050100                     MOVE    WS-VS1R1-F-G-120-140 TO COMPUTED-X   RL2114.2
050200                     MOVE   "ABCDEF " TO CORRECT-X  RL2114.2
050300                     MOVE   "WRONG LENGTH RECORD" TO RE-MARK      RL2114.2
050400                     PERFORM FAIL                                 RL2114.2
050500                     PERFORM PRINT-DETAIL.                        RL2114.2
050600 REL-TEST-5.                                                      RL2114.2
050700     MOVE   "VII-31 3.8.4 GR 5" TO ANSI-REFERENCE.                RL2114.2
050800     MOVE   "REL-TEST-5" TO PAR-NAME.                             RL2114.2
050900     IF      WRK-CS-09V00 = 32                                    RL2114.2
051000             IF      WS-VS1R1-F-G-120-140 =                       RL2114.2
051100                                 "ABCDEFGHIJKLMNOP "          RL2114.2
051200                     PERFORM PASS                                 RL2114.2
051300*                    PERFORM PRINT-DETAIL                         RL2114.2
051400             ELSE                                                 RL2114.2
051500                     MOVE    WS-VS1R1-F-G-120-140 TO COMPUTED-X   RL2114.2
051600                     MOVE   "ABCDEFGHIJKLMNOP " TO CORRECT-X  RL2114.2
051700                     MOVE   "WRONG LENGTH RECORD" TO RE-MARK      RL2114.2
051800                     PERFORM FAIL                                 RL2114.2
051900                     PERFORM PRINT-DETAIL.                        RL2114.2
052000 REL-TEST-6.                                                      RL2114.2
052100     MOVE   "VII-31 3.8.4 GR 5 & 5B" TO ANSI-REFERENCE.           RL2114.2
052200     MOVE   "REL-TEST-6" TO PAR-NAME.                             RL2114.2
052300     IF      WRK-CS-09V00 > 32                                    RL2114.2
052400             IF      WS-VS1R1-F-G-120-140 =                       RL2114.2
052500                                 "ABCDEFGHIJKLMNOPQRSTU"          RL2114.2
052600                     PERFORM PASS                                 RL2114.2
052700*                    PERFORM PRINT-DETAIL                         RL2114.2
052800             ELSE                                                 RL2114.2
052900                     MOVE    WS-VS1R1-F-G-120-140 TO COMPUTED-X   RL2114.2
053000                     MOVE   "ABCDEFGHIJKLMNOPQRSTU" TO CORRECT-X  RL2114.2
053100                     MOVE   "WRONG LENGTH RECORD" TO RE-MARK      RL2114.2
053200                     PERFORM FAIL                                 RL2114.2
053300                     PERFORM PRINT-DETAIL.                        RL2114.2
053400     GO      TO REL-INIT-1.                                       RL2114.2
053500 REL-DELETE-002.                                                  RL2114.2
053600     PERFORM DE-LETE.                                             RL2114.2
053700     PERFORM PRINT-DETAIL.                                        RL2114.2
053800 REL-TEST-002-2.                                                  RL2114.2
053900     MOVE   "REL-TEST-002-2" TO PAR-NAME.                         RL2114.2
054000     IF      XRECORD-NUMBER (1) NOT EQUAL TO 500                  RL2114.2
054100             PERFORM FAIL                                         RL2114.2
054200     ELSE                                                         RL2114.2
054300             PERFORM PASS.                                        RL2114.2
054400     GO      TO REL-WRITE-002.                                    RL2114.2
054500 REL-WRITE-002.                                                   RL2114.2
054600     MOVE   "REL-TEST-002" TO PAR-NAME.                           RL2114.2
054700     MOVE   "FILE VERIFIED, LFILE" TO COMPUTED-A.                 RL2114.2
054800     MOVE    XRECORD-NUMBER (1) TO CORRECT-18V0.                  RL2114.2
054900     PERFORM PRINT-DETAIL.                                        RL2114.2
055000     CLOSE   RL-VS1.                                              RL2114.2
055100 CCVS-EXIT SECTION.                                               RL2114.2
055200 CCVS-999999.                                                     RL2114.2
055300     GO TO CLOSE-FILES.                                           RL2114.2

¤ Dauer der Verarbeitung: 0.16 Sekunden  (vorverarbeitet)  ¤





Download des
Quellennavigators
Download des
sprechenden Kalenders

in der Quellcodebibliothek suchen




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