Gedichte Musik Bilder Quellcodebibliothek Diashow Normaldarstellung
Quellcodebibliothek Statistik Leitseite products/Sources/formale Sprachen/Cobol/Test-Suite/COBOL/IX/     Datei vom 4.1.2008 mit Größe 40 kB image not shown  

Quelle  ix101a.cob   Sprache: Cobol

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

96%


¤ Dauer der Verarbeitung: 0.17 Sekunden  (vorverarbeitet)  ¤

*© Formatika GbR, Deutschland




Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

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.