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

Quelle  sq134a.cob   Sprache: Cobol

 
000100 IDENTIFICATION DIVISION.                                         SQ1344.2
000200 PROGRAM-ID.                                                      SQ1344.2
000300     SQ134A.                                                      SQ1344.2
000400****************************************************************  SQ1344.2
000500*                                                              *  SQ1344.2
000600*    VALIDATION FOR:-                                          *  SQ1344.2
000700*    "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH.     ".SQ1344.2
000800*    USING CCVS85 VERSION 1.0 ISSUED IN JANUARY 1986.          *  SQ1344.2
000900*                             REVISED 1986, AUGUST             *  SQ1344.2
001000*                                                              *  SQ1344.2
001100*    CREATION DATE     /     VALIDATION DATE                   *  SQ1344.2
001200*    "COBOL 85 VERSION 4.2, Apr  1993 SSVG                      ".SQ1344.2
001300*                                                              *  SQ1344.2
001400****************************************************************  SQ1344.2
001500*                                                              *  SQ1344.2
001600*      X-CARDS USED BY THIS PROGRAM ARE :-                     *  SQ1344.2
001700*                                                              *  SQ1344.2
001800*            X-14   SEQUENTIAL MASS STORAGE FILE               *  SQ1344.2
001900*            X-55   SYSTEM PRINTER                             *  SQ1344.2
002000*            X-82   SOURCE-COMPUTER                            *  SQ1344.2
002100*            X-83   OBJECT-COMPUTER.                           *  SQ1344.2
002200*                                                              *  SQ1344.2
002300****************************************************************  SQ1344.2
002400*                                                              *  SQ1344.2
002500*    THIS PROGRAM OPENS FOR OUTPUT A FILE WHICH IS ASSIGNED    *  SQ1344.2
002600*    TO A MASS STORAGE MEDIUM, WRITES ONE RECORD AND CLOSES    *  SQ1344.2
002700*    THE FILE.  TWO RECORD SIZES ARE DEFINED FOR THE FILE, BY  *  SQ1344.2
002800*    MEANS OF THE RECORD CONTAINS CLAUSE.  THE FILE IS THEN    *  SQ1344.2
002900*    OPENED FOR I-O, AND A READ STATEMENT AND A REWRITE        *  SQ1344.2
003000*    STATEMENT ARE EXECUTED.  THE REWRITE STATEMENT REFERENCES *  SQ1344.2
003100*    A RECORD OF A DIFFERENT SIZE TO THAT REFERENCED IN THE    *  SQ1344.2
003200*    WRITE STATEMENT, AND SHOULD CAUSE AN EXCEPTION CONDITION  *  SQ1344.2
003300*    WITH I-O STATUS "44".  THIS LOGIC ERROR SHOULD CAUSE      *  SQ1344.2
003400*    ENTRY TO THE APPLICABLE ERROR DECLARATIVE.                *  SQ1344.2
003500*                                                              *  SQ1344.2
003600*    THIS PROGRAM SHOULD BE RUN ONLY WHEN AN IMPLEMENTATION    *  SQ1344.2
003700*    PROVIDES VARIABLE LENGTH RECORDS FOR THE RECORDS CONTAINS *  SQ1344.2
003800*    INTEGER TO INTEGER CLAUSE                                 *  SQ1344.2
003900*                                                              *  SQ1344.2
004000*    THIS PROGRAM HAS BEEN SPLIT FROM V2.0 ONWARDS.            *  SQ1344.2
004100*    THE NEW PROGRAM IS SQ145A.                                *  SQ1344.2
004200****************************************************************  SQ1344.2
004300*                                                                 SQ1344.2
004400 ENVIRONMENT DIVISION.                                            SQ1344.2
004500 CONFIGURATION SECTION.                                           SQ1344.2
004600 SOURCE-COMPUTER.                                                 SQ1344.2
004700     Card0130.                                                    SQ1344.2
004800 OBJECT-COMPUTER.                                                 SQ1344.2
004900     Card0131.                                                    SQ1344.2
005000*                                                                 SQ1344.2
005100 INPUT-OUTPUT SECTION.                                            SQ1344.2
005200 FILE-CONTROL.                                                    SQ1344.2
005300     SELECT PRINT-FILE ASSIGN TO                                  SQ1344.2
005400     "C0085" .                                                    SQ1344.2
005500*                                                                 SQ1344.2
005600     SELECT RAW-DATA   ASSIGN TO                                  SQ1344.2
005700     "C0098"                                                      SQ1344.2
005800           ORGANIZATION IS INDEXED                                SQ1344.2
005900           ACCESS MODE  IS RANDOM                                 SQ1344.2
006000           RECORD KEY   IS RAW-DATA-KEY.                          SQ1344.2
006100                                                                  SQ1344.2
006200     SELECT SQ-FS4                                                SQ1344.2
006300            ASSIGN                                                SQ1344.2
006400     "C0020"                                                      SQ1344.2
006500            STATUS SQ-FS4-STATUS OF STATUS-GROUP                  SQ1344.2
006600            SEQUENTIAL                                            SQ1344.2
006700            .                                                     SQ1344.2
006800*                                                                 SQ1344.2
006900*                                                                 SQ1344.2
007000 DATA DIVISION.                                                   SQ1344.2
007100 FILE SECTION.                                                    SQ1344.2
007200 FD  PRINT-FILE                                                   SQ1344.2
007300     LABEL RECORDS                                                SQ1344.2
007400     Card0132                                                     SQ1344.2
007500     DATA RECORD IS PRINT-REC DUMMY-RECORD                        SQ1344.2
007600               .                                                  SQ1344.2
007700 01  PRINT-REC    PICTURE X(120).                                 SQ1344.2
007800 01  DUMMY-RECORD PICTURE X(120).                                 SQ1344.2
007900                                                                  SQ1344.2
008000 FD  RAW-DATA.                                                    SQ1344.2
008100 01  RAW-DATA-SATZ.                                               SQ1344.2
008200     05  RAW-DATA-KEY        PIC X(6).                            SQ1344.2
008300     05  C-DATE              PIC 9(6).                            SQ1344.2
008400     05  C-TIME              PIC 9(8).                            SQ1344.2
008500     05  NO-OF-TESTS         PIC 99.                              SQ1344.2
008600     05  C-OK                PIC 999.                             SQ1344.2
008700     05  C-ALL               PIC 999.                             SQ1344.2
008800     05  C-FAIL              PIC 999.                             SQ1344.2
008900     05  C-DELETED           PIC 999.                             SQ1344.2
009000     05  C-INSPECT           PIC 999.                             SQ1344.2
009100     05  C-NOTE              PIC X(13).                           SQ1344.2
009200     05  C-INDENT            PIC X.                               SQ1344.2
009300     05  C-ABORT             PIC X(8).                            SQ1344.2
009400*                                                                 SQ1344.2
009500 FD  SQ-FS4                                                       SQ1344.2
009600     LABEL RECORD IS STANDARD                                     SQ1344.2
009700     BLOCK  120 CHARACTERS                                        SQ1344.2
009800     RECORD CONTAINS 120 TO 138 CHARACTERS                        SQ1344.2
009900                .                                                 SQ1344.2
010000 01  SQ-FS4R1-F-G-120.                                            SQ1344.2
010100        05 FFILE-RECORD-INFO-P1-120.                              SQ1344.2
010200           07 FILLER              PIC X(5).                       SQ1344.2
010300           07 FFILE-NAME          PIC X(6).                       SQ1344.2
010400           07 FILLER              PIC X(8).                       SQ1344.2
010500           07 FRECORD-NAME        PIC X(6).                       SQ1344.2
010600           07 FILLER              PIC X(1).                       SQ1344.2
010700           07 FREELUNIT-NUMBER    PIC 9(1).                       SQ1344.2
010800           07 FILLER              PIC X(7).                       SQ1344.2
010900           07 FRECORD-NUMBER      PIC 9(6).                       SQ1344.2
011000           07 FILLER              PIC X(6).                       SQ1344.2
011100           07 FUPDATE-NUMBER      PIC 9(2).                       SQ1344.2
011200           07 FILLER              PIC X(5).                       SQ1344.2
011300           07 FODO-NUMBER         PIC 9(4).                       SQ1344.2
011400           07 FILLER              PIC X(5).                       SQ1344.2
011500           07 FPROGRAM-NAME       PIC X(5).                       SQ1344.2
011600           07 FILLER              PIC X(7).                       SQ1344.2
011700           07 FRECORD-LENGTH      PIC 9(6).                       SQ1344.2
011800           07 FILLER              PIC X(7).                       SQ1344.2
011900           07 FCHARS-OR-RECORDS   PIC X(2).                       SQ1344.2
012000           07 FILLER              PIC X(1).                       SQ1344.2
012100           07 FBLOCK-SIZE         PIC 9(4).                       SQ1344.2
012200           07 FILLER              PIC X(6).                       SQ1344.2
012300           07 FRECORDS-IN-FILE    PIC 9(6).                       SQ1344.2
012400           07 FILLER              PIC X(5).                       SQ1344.2
012500           07 FFILE-ORGANIZATION  PIC X(2).                       SQ1344.2
012600           07 FILLER              PIC X(6).                       SQ1344.2
012700           07 FLABEL-TYPE         PIC X(1).                       SQ1344.2
012800*                                                                 SQ1344.2
012900 01  SQ-FS4R2-F-G-138.                                            SQ1344.2
013000     03  FILLER PIC X(120).                                       SQ1344.2
013100     03  EXT-18 PIC X(18).                                        SQ1344.2
013200*                                                                 SQ1344.2
013300 WORKING-STORAGE SECTION.                                         SQ1344.2
013400*                                                                 SQ1344.2
013500***************************************************************   SQ1344.2
013600*                                                             *   SQ1344.2
013700*    WORKING-STORAGE DATA ITEMS SPECIFIC TO THIS TEST SUITE   *   SQ1344.2
013800*                                                             *   SQ1344.2
013900***************************************************************   SQ1344.2
014000*                                                                 SQ1344.2
014100 01  STATUS-GROUP.                                                SQ1344.2
014200     04  SQ-FS4-STATUS.                                           SQ1344.2
014300         07  SQ-FS4-KEY-1   PIC X.                                SQ1344.2
014400         07  SQ-FS4-KEY-2   PIC X.                                SQ1344.2
014500*                                                                 SQ1344.2
014600 01  DELETE-SW.                                                   SQ1344.2
014700     03  DELETE-SW-1 PIC X.                                       SQ1344.2
014800     03  DELETE-SW-1-GROUP.                                       SQ1344.2
014900         05  DELETE-SW-2 PIC X.                                   SQ1344.2
015000*                                                                 SQ1344.2
015100 01  DECL-EXEC-I-O PIC X(12).                                     SQ1344.2
015200*                                                                 SQ1344.2
015300 01  DECL-EXEC-SW PIC X.                                          SQ1344.2
015400*                                                                 SQ1344.2
015500***************************************************************   SQ1344.2
015600*                                                             *   SQ1344.2
015700*    WORKING-STORAGE DATA ITEMS USED BY THE CCVS              *   SQ1344.2
015800*                                                             *   SQ1344.2
015900***************************************************************   SQ1344.2
016000*                                                                 SQ1344.2
016100 01  REC-SKEL-SUB   PIC 99.                                       SQ1344.2
016200*                                                                 SQ1344.2
016300 01  FILE-RECORD-INFORMATION-REC.                                 SQ1344.2
016400     03 FILE-RECORD-INFO-SKELETON.                                SQ1344.2
016500        05 FILLER                 PICTURE X(48)       VALUE       SQ1344.2
016600             "FILE= ,RECORD= /0,RECNO=000000,UPDT=00".  SQ1344.2
016700        05 FILLER                 PICTURE X(46)       VALUE       SQ1344.2
016800             ",ODO=0000,PGM= ,LRECL=000000,BLKSIZ =0000".    SQ1344.2
016900        05 FILLER                 PICTURE X(26)       VALUE       SQ1344.2
017000             ",LFIL=000000,ORG= ,LBLR= ".                        SQ1344.2
017100        05 FILLER                 PICTURE X(37)       VALUE       SQ1344.2
017200             ",RECKEY= ".             SQ1344.2
017300        05 FILLER                 PICTURE X(38)       VALUE       SQ1344.2
017400             ",ALTKEY1= ".            SQ1344.2
017500        05 FILLER                 PICTURE X(38)       VALUE       SQ1344.2
017600             ",ALTKEY2= ".            SQ1344.2
017700        05 FILLER                 PICTURE X(7)        VALUE SPACE.SQ1344.2
017800     03 FILE-RECORD-INFO          OCCURS  10  TIMES.              SQ1344.2
017900        05 FILE-RECORD-INFO-P1-120.                               SQ1344.2
018000           07 FILLER              PIC X(5).                       SQ1344.2
018100           07 XFILE-NAME          PIC X(6).                       SQ1344.2
018200           07 FILLER              PIC X(8).                       SQ1344.2
018300           07 XRECORD-NAME        PIC X(6).                       SQ1344.2
018400           07 FILLER              PIC X(1).                       SQ1344.2
018500           07 REELUNIT-NUMBER     PIC 9(1).                       SQ1344.2
018600           07 FILLER              PIC X(7).                       SQ1344.2
018700           07 XRECORD-NUMBER      PIC 9(6).                       SQ1344.2
018800           07 FILLER              PIC X(6).                       SQ1344.2
018900           07 UPDATE-NUMBER       PIC 9(2).                       SQ1344.2
019000           07 FILLER              PIC X(5).                       SQ1344.2
019100           07 ODO-NUMBER          PIC 9(4).                       SQ1344.2
019200           07 FILLER              PIC X(5).                       SQ1344.2
019300           07 XPROGRAM-NAME       PIC X(5).                       SQ1344.2
019400           07 FILLER              PIC X(7).                       SQ1344.2
019500           07 XRECORD-LENGTH      PIC 9(6).                       SQ1344.2
019600           07 FILLER              PIC X(7).                       SQ1344.2
019700           07 CHARS-OR-RECORDS    PIC X(2).                       SQ1344.2
019800           07 FILLER              PIC X(1).                       SQ1344.2
019900           07 XBLOCK-SIZE         PIC 9(4).                       SQ1344.2
020000           07 FILLER              PIC X(6).                       SQ1344.2
020100           07 RECORDS-IN-FILE     PIC 9(6).                       SQ1344.2
020200           07 FILLER              PIC X(5).                       SQ1344.2
020300           07 XFILE-ORGANIZATION  PIC X(2).                       SQ1344.2
020400           07 FILLER              PIC X(6).                       SQ1344.2
020500           07 XLABEL-TYPE         PIC X(1).                       SQ1344.2
020600        05 FILE-RECORD-INFO-P121-240.                             SQ1344.2
020700           07 FILLER              PIC X(8).                       SQ1344.2
020800           07 XRECORD-KEY         PIC X(29).                      SQ1344.2
020900           07 FILLER              PIC X(9).                       SQ1344.2
021000           07 ALTERNATE-KEY1      PIC X(29).                      SQ1344.2
021100           07 FILLER              PIC X(9).                       SQ1344.2
021200           07 ALTERNATE-KEY2      PIC X(29).                      SQ1344.2
021300           07 FILLER              PIC X(7).                       SQ1344.2
021400*                                                                 SQ1344.2
021500 01  TEST-RESULTS.                                                SQ1344.2
021600     02 FILLER              PIC X      VALUE SPACE.               SQ1344.2
021700     02  PAR-NAME.                                                SQ1344.2
021800       03 FILLER              PIC X(14)  VALUE SPACE.             SQ1344.2
021900       03 PARDOT-X            PIC X      VALUE SPACE.             SQ1344.2
022000       03 DOTVALUE            PIC 99     VALUE ZERO.              SQ1344.2
022100     02 FILLER              PIC X      VALUE SPACE.               SQ1344.2
022200     02 FEATURE             PIC X(24)  VALUE SPACE.               SQ1344.2
022300     02 FILLER              PIC X      VALUE SPACE.               SQ1344.2
022400     02 P-OR-F              PIC X(5)   VALUE SPACE.               SQ1344.2
022500     02 FILLER              PIC X(9)   VALUE SPACE.               SQ1344.2
022600     02 RE-MARK             PIC X(61).                            SQ1344.2
022700 01  TEST-COMPUTED.                                               SQ1344.2
022800   02 FILLER  PIC X(30)  VALUE SPACE.                             SQ1344.2
022900   02 FILLER  PIC X(17)  VALUE " COMPUTED =".                SQ1344.2
023000   02 COMPUTED-X.                                                 SQ1344.2
023100     03 COMPUTED-A    PIC X(20)  VALUE SPACE.                     SQ1344.2
023200     03 COMPUTED-N    REDEFINES COMPUTED-A PIC -9(9).9(9).        SQ1344.2
023300     03 COMPUTED-0V18 REDEFINES COMPUTED-A PIC -.9(18).           SQ1344.2
023400     03 COMPUTED-4V14 REDEFINES COMPUTED-A PIC -9(4).9(14).       SQ1344.2
023500     03 COMPUTED-14V4 REDEFINES COMPUTED-A PIC -9(14).9(4).       SQ1344.2
023600     03       CM-18V0 REDEFINES COMPUTED-A.                       SQ1344.2
023700        04 COMPUTED-18V0                   PIC -9(18).            SQ1344.2
023800        04 FILLER                          PIC X.                 SQ1344.2
023900     03 FILLER PIC X(50) VALUE SPACE.                             SQ1344.2
024000 01  TEST-CORRECT.                                                SQ1344.2
024100     02 FILLER PIC X(30) VALUE SPACE.                             SQ1344.2
024200     02 FILLER PIC X(17) VALUE " CORRECT =".                SQ1344.2
024300     02 CORRECT-X.                                                SQ1344.2
024400     03 CORRECT-A                  PIC X(20) VALUE SPACE.         SQ1344.2
024500     03 CORRECT-N    REDEFINES CORRECT-A     PIC -9(9).9(9).      SQ1344.2
024600     03 CORRECT-0V18 REDEFINES CORRECT-A     PIC -.9(18).         SQ1344.2
024700     03 CORRECT-4V14 REDEFINES CORRECT-A     PIC -9(4).9(14).     SQ1344.2
024800     03 CORRECT-14V4 REDEFINES CORRECT-A     PIC -9(14).9(4).     SQ1344.2
024900     03      CR-18V0 REDEFINES CORRECT-A.                         SQ1344.2
025000         04 CORRECT-18V0                     PIC -9(18).          SQ1344.2
025100         04 FILLER                           PIC X.               SQ1344.2
025200     03 FILLER PIC X(2) VALUE SPACE.                              SQ1344.2
025300     03 COR-ANSI-REFERENCE             PIC X(48) VALUE SPACE.     SQ1344.2
025400*                                                                 SQ1344.2
025500 01  CCVS-C-1.                                                    SQ1344.2
025600     02 FILLER  PIC IS X        VALUE  SPACE.                     SQ1344.2
025700     02 FILLER  PIC IS X(17)    VALUE "PARAGRAPH-NAME".           SQ1344.2
025800     02 FILLER  PIC IS X        VALUE  SPACE.                     SQ1344.2
025900     02 FILLER  PIC IS X(24)    VALUE IS "FEATURE".               SQ1344.2
026000     02 FILLER  PIC IS X        VALUE  SPACE.                     SQ1344.2
026100     02 FILLER  PIC IS X(5)     VALUE "PASS ".                    SQ1344.2
026200     02 FILLER  PIC IS X(9)     VALUE  SPACE.                     SQ1344.2
026300     02 FILLER  PIC IS X(62)    VALUE "REMARKS".                  SQ1344.2
026400 01  CCVS-C-2.                                                    SQ1344.2
026500     02 FILLER  PIC X(19)  VALUE  SPACE.                          SQ1344.2
026600     02 FILLER  PIC X(6)   VALUE "TESTED".                        SQ1344.2
026700     02 FILLER  PIC X(19)  VALUE  SPACE.                          SQ1344.2
026800     02 FILLER  PIC X(4)   VALUE "FAIL".                          SQ1344.2
026900     02 FILLER  PIC X(72)  VALUE  SPACE.                          SQ1344.2
027000*                                                                 SQ1344.2
027100 01  REC-SKL-SUB       PIC 9(2)     VALUE ZERO.                   SQ1344.2
027200 01  REC-CT            PIC 99       VALUE ZERO.                   SQ1344.2
027300 01  DELETE-COUNTER    PIC 999      VALUE ZERO.                   SQ1344.2
027400 01  ERROR-COUNTER     PIC 999      VALUE ZERO.                   SQ1344.2
027500 01  INSPECT-COUNTER   PIC 999      VALUE ZERO.                   SQ1344.2
027600 01  PASS-COUNTER      PIC 999      VALUE ZERO.                   SQ1344.2
027700 01  TOTAL-ERROR       PIC 999      VALUE ZERO.                   SQ1344.2
027800 01  ERROR-HOLD        PIC 999      VALUE ZERO.                   SQ1344.2
027900 01  DUMMY-HOLD        PIC X(120)   VALUE SPACE.                  SQ1344.2
028000 01  RECORD-COUNT      PIC 9(5)     VALUE ZERO.                   SQ1344.2
028100 01  ANSI-REFERENCE    PIC X(48)    VALUE SPACES.                 SQ1344.2
028200 01  CCVS-H-1.                                                    SQ1344.2
028300     02  FILLER          PIC X(39)    VALUE SPACES.               SQ1344.2
028400     02  FILLER          PIC X(42)    VALUE                       SQ1344.2
028500     "OFFICIAL COBOL COMPILER VALIDATION SYSTEM".                 SQ1344.2
028600     02  FILLER          PIC X(39)    VALUE SPACES.               SQ1344.2
028700 01  CCVS-H-2A.                                                   SQ1344.2
028800   02  FILLER            PIC X(40)  VALUE SPACE.                  SQ1344.2
028900   02  FILLER            PIC X(7)   VALUE "CCVS85 ".              SQ1344.2
029000   02  FILLER            PIC XXXX   VALUE                         SQ1344.2
029100     "4.2 ".                                                      SQ1344.2
029200   02  FILLER            PIC X(28)  VALUE                         SQ1344.2
029300            " COPY - NOT FOR DISTRIBUTION".                       SQ1344.2
029400   02  FILLER            PIC X(41)  VALUE SPACE.                  SQ1344.2
029500*                                                                 SQ1344.2
029600 01  CCVS-H-2B.                                                   SQ1344.2
029700   02  FILLER            PIC X(15)  VALUE "TEST RESULT OF ".      SQ1344.2
029800   02  TEST-ID           PIC X(9).                                SQ1344.2
029900   02  FILLER            PIC X(4)   VALUE " IN ".                 SQ1344.2
030000   02  FILLER            PIC X(12)  VALUE                         SQ1344.2
030100     " HIGH ".                                              SQ1344.2
030200   02  FILLER            PIC X(22)  VALUE                         SQ1344.2
030300            " LEVEL VALIDATION FOR ".                             SQ1344.2
030400   02  FILLER            PIC X(58)  VALUE                         SQ1344.2
030500     "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1344.2
030600 01  CCVS-H-3.                                                    SQ1344.2
030700     02  FILLER          PIC X(34)  VALUE                         SQ1344.2
030800            " FOR OFFICIAL USE ONLY ".                         SQ1344.2
030900     02  FILLER          PIC X(58)  VALUE                         SQ1344.2
031000     "COBOL 85 VERSION 4.2, Apr 1993 SSVG ".SQ1344.2
031100     02  FILLER          PIC X(28)  VALUE                         SQ1344.2
031200            " COPYRIGHT 1985,1986 ".                           SQ1344.2
031300 01  CCVS-E-1.                                                    SQ1344.2
031400     02 FILLER           PIC X(52)  VALUE SPACE.                  SQ1344.2
031500     02 FILLER  PIC X(14) VALUE IS "END OF TEST- ".              SQ1344.2
031600     02 ID-AGAIN         PIC X(9).                                SQ1344.2
031700     02 FILLER           PIC X(45)  VALUE SPACES.                 SQ1344.2
031800 01  CCVS-E-2.                                                    SQ1344.2
031900     02  FILLER          PIC X(31)  VALUE SPACE.                  SQ1344.2
032000     02  FILLER          PIC X(21)  VALUE SPACE.                  SQ1344.2
032100     02  CCVS-E-2-2.                                              SQ1344.2
032200         03 ERROR-TOTAL    PIC XXX    VALUE SPACE.                SQ1344.2
032300         03 FILLER         PIC X      VALUE SPACE.                SQ1344.2
032400         03 ENDER-DESC     PIC X(44)  VALUE                       SQ1344.2
032500            "ERRORS ENCOUNTERED".                                 SQ1344.2
032600 01  CCVS-E-3.                                                    SQ1344.2
032700     02  FILLER          PIC X(22)  VALUE                         SQ1344.2
032800            " FOR OFFICIAL USE ONLY".                             SQ1344.2
032900     02  FILLER          PIC X(12)  VALUE SPACE.                  SQ1344.2
033000     02  FILLER          PIC X(58)  VALUE                         SQ1344.2
033100     "ON-SITE VALIDATION, NATIONAL INSTITUTE OF STD & TECH. ".SQ1344.2
033200     02  FILLER          PIC X(8)   VALUE SPACE.                  SQ1344.2
033300     02  FILLER          PIC X(20)  VALUE                         SQ1344.2
033400             " COPYRIGHT 1985,1986".                              SQ1344.2
033500 01  CCVS-E-4.                                                    SQ1344.2
033600     02 CCVS-E-4-1       PIC XXX    VALUE SPACE.                  SQ1344.2
033700     02 FILLER           PIC X(4)   VALUE " OF ".                 SQ1344.2
033800     02 CCVS-E-4-2       PIC XXX    VALUE SPACE.                  SQ1344.2
033900     02 FILLER           PIC X(40)  VALUE                         SQ1344.2
034000      " TESTS WERE EXECUTED SUCCESSFULLY".                       SQ1344.2
034100 01  XXINFO.                                                      SQ1344.2
034200     02 FILLER           PIC X(19)  VALUE "*** INFORMATION ***".  SQ1344.2
034300     02 INFO-TEXT.                                                SQ1344.2
034400       04 FILLER             PIC X(8)   VALUE SPACE.              SQ1344.2
034500       04 XXCOMPUTED         PIC X(20).                           SQ1344.2
034600       04 FILLER             PIC X(5)   VALUE SPACE.              SQ1344.2
034700       04 XXCORRECT          PIC X(20).                           SQ1344.2
034800     02 INF-ANSI-REFERENCE PIC X(48).                             SQ1344.2
034900 01  HYPHEN-LINE.                                                 SQ1344.2
035000     02 FILLER  PIC IS X VALUE IS SPACE.                          SQ1344.2
035100     02 FILLER  PIC IS X(65)    VALUE IS "************************SQ1344.2
035200-    "*****************************************".                 SQ1344.2
035300     02 FILLER  PIC IS X(54)    VALUE IS "************************SQ1344.2
035400-    "******************************".                            SQ1344.2
035500 01  CCVS-PGM-ID  PIC X(9)   VALUE                                SQ1344.2
035600     "SQ134A".                                                    SQ1344.2
035700*                                                                 SQ1344.2
035800*                                                                 SQ1344.2
035900 PROCEDURE DIVISION.                                              SQ1344.2
036000 DECLARATIVES.                                                    SQ1344.2
036100*                                                                 SQ1344.2
036200 SECT-SQ134A-0001 SECTION.                                        SQ1344.2
036300     USE AFTER EXCEPTION PROCEDURE I-O.                           SQ1344.2
036400 I-O-ERROR-PROCESS.                                               SQ1344.2
036500     MOVE   "EXECUTED" TO DECL-EXEC-I-O.                          SQ1344.2
036600     IF DECL-EXEC-SW NOT = SPACE                                  SQ1344.2
036700         GO TO   END-DECLS.                                       SQ1344.2
036800*                                                                 SQ1344.2
036900     MOVE    1 TO REC-CT.                                         SQ1344.2
037000     MOVE   "REWRITE SHORTER RECORD"  TO FEATURE.                 SQ1344.2
037100     MOVE   "DCL-REWRITE-01" TO PAR-NAME.                         SQ1344.2
037200     GO TO   DCL-REWRITE-01-01.                                   SQ1344.2
037300 DECL-DELETE-01-01.                                               SQ1344.2
037400     PERFORM DECL-DE-LETE.                                        SQ1344.2
037500     GO TO   DECL-TEST-01-01-END.                                 SQ1344.2
037600 DCL-REWRITE-01-01.                                               SQ1344.2
037700     IF SQ-FS4-STATUS = "44"                                      SQ1344.2
037800         PERFORM DECL-PASS                                        SQ1344.2
037900     ELSE                                                         SQ1344.2
038000         MOVE    SQ-FS4-STATUS TO COMPUTED-A                      SQ1344.2
038100         MOVE   "44" TO CORRECT-A                                 SQ1344.2
038200         MOVE   "UNEXPECTED I-O STATUS ON FAILED REWRITE"         SQ1344.2
038300                   TO RE-MARK                                     SQ1344.2
038400         MOVE   "VII-4, VII-48,4.5.4(2)" TO ANSI-REFERENCE        SQ1344.2
038500         PERFORM DECL-FAIL.                                       SQ1344.2
038600 DECL-TEST-01-01-END.                                             SQ1344.2
038700*                                                                 SQ1344.2
038800     ADD     1 TO REC-CT.                                         SQ1344.2
038900     GO TO   DCL-REWRITE-01-02.                                   SQ1344.2
039000 DECL-DELETE-01-02.                                               SQ1344.2
039100     PERFORM DECL-DE-LETE.                                        SQ1344.2
039200     GO TO   DECL-TEST-01-02-END.                                 SQ1344.2
039300 DCL-REWRITE-01-02.                                               SQ1344.2
039400     IF SQ-FS4R1-F-G-120 = FILE-RECORD-INFO-P1-120 (1)            SQ1344.2
039500         PERFORM DECL-PASS                                        SQ1344.2
039600     ELSE                                                         SQ1344.2
039700         MOVE   "FIRST 120 CHARACTERS OF RECORD AREA CHANGED"     SQ1344.2
039800                   TO RE-MARK                                     SQ1344.2
039900         MOVE   "VII-4, VII-49,4.5.4(9)" TO ANSI-REFERENCE        SQ1344.2
040000         PERFORM DECL-FAIL.                                       SQ1344.2
040100 DECL-TEST-01-02-END.                                             SQ1344.2
040200*                                                                 SQ1344.2
040300     ADD     1 TO REC-CT.                                         SQ1344.2
040400     GO TO   DCL-REWRITE-01-03.                                   SQ1344.2
040500 DECL-DELETE-01-03.                                               SQ1344.2
040600     PERFORM DECL-DE-LETE.                                        SQ1344.2
040700     GO TO   DECL-TEST-01-03-END.                                 SQ1344.2
040800 DCL-REWRITE-01-03.                                               SQ1344.2
040900     IF EXT-18 = "ABCDEFGHIJKLMNOPQR"                             SQ1344.2
041000         PERFORM DECL-PASS                                        SQ1344.2
041100     ELSE                                                         SQ1344.2
041200         MOVE    EXT-18 TO COMPUTED-A                             SQ1344.2
041300         MOVE   "ABCDEFGHIJKLMNOPQR" TO CORRECT-A                 SQ1344.2
041400         MOVE   "LAST 18 CHARACTERS OF RECORD CHANGED"            SQ1344.2
041500                   TO RE-MARK                                     SQ1344.2
041600         MOVE   "VII-4, VII-49,4.5.4(9)" TO ANSI-REFERENCE        SQ1344.2
041700         PERFORM DECL-FAIL.                                       SQ1344.2
041800 DECL-TEST-01-03-END.                                             SQ1344.2
041900*                                                                 SQ1344.2
042000     PERFORM DECL-WRITE-LINE.                                     SQ1344.2
042100     MOVE   "ABNORMAL TERMINATION AT THIS POINT IS ACCEPTABLE"    SQ1344.2
042200               TO DUMMY-RECORD.                                   SQ1344.2
042300     PERFORM DECL-WRITE-LINE 3 TIMES.                             SQ1344.2
042400     GO TO   END-DECLS.                                           SQ1344.2
042500*                                                                 SQ1344.2
042600*                                                                 SQ1344.2
042700 DECL-PASS.                                                       SQ1344.2
042800     MOVE   "PASS " TO P-OR-F.                                    SQ1344.2
042900     ADD     1 TO PASS-COUNTER.                                   SQ1344.2
043000     PERFORM DECL-PRINT-DETAIL.                                   SQ1344.2
043100*                                                                 SQ1344.2
043200 DECL-FAIL.                                                       SQ1344.2
043300     MOVE   "FAIL*" TO P-OR-F.                                    SQ1344.2
043400     ADD     1 TO ERROR-COUNTER.                                  SQ1344.2
043500     PERFORM DECL-PRINT-DETAIL.                                   SQ1344.2
043600*                                                                 SQ1344.2
043700 DECL-DE-LETE.                                                    SQ1344.2
043800     MOVE   "****TEST DELETED****" TO RE-MARK.                    SQ1344.2
043900     MOVE   "*****" TO P-OR-F.                                    SQ1344.2
044000     ADD     1 TO DELETE-COUNTER.                                 SQ1344.2
044100     PERFORM DECL-PRINT-DETAIL.                                   SQ1344.2
044200*                                                                 SQ1344.2
044300 DECL-PRINT-DETAIL.                                               SQ1344.2
044400     IF REC-CT NOT EQUAL TO ZERO                                  SQ1344.2
044500             MOVE "." TO PARDOT-X                                 SQ1344.2
044600             MOVE REC-CT TO DOTVALUE.                             SQ1344.2
044700     MOVE    TEST-RESULTS TO PRINT-REC.                           SQ1344.2
044800     PERFORM DECL-WRITE-LINE.                                     SQ1344.2
044900     IF P-OR-F EQUAL TO "FAIL*"                                   SQ1344.2
045000         PERFORM DECL-WRITE-LINE                                  SQ1344.2
045100         PERFORM DECL-FAIL-ROUTINE THRU DECL-FAIL-EX              SQ1344.2
045200     ELSE                                                         SQ1344.2
045300         PERFORM DECL-BAIL THRU DECL-BAIL-EX.                     SQ1344.2
045400     MOVE    SPACE TO P-OR-F.                                     SQ1344.2
045500     MOVE    SPACE TO COMPUTED-X.                                 SQ1344.2
045600     MOVE    SPACE TO CORRECT-X.                                  SQ1344.2
045700     IF REC-CT EQUAL TO ZERO                                      SQ1344.2
045800         MOVE    SPACE TO PAR-NAME.                               SQ1344.2
045900     MOVE    SPACE TO RE-MARK.                                    SQ1344.2
046000*                                                                 SQ1344.2
046100 DECL-WRITE-LINE.                                                 SQ1344.2
046200     ADD     1 TO RECORD-COUNT.                                   SQ1344.2
046300     IF RECORD-COUNT GREATER 50                                   SQ1344.2
046400         MOVE    DUMMY-RECORD TO DUMMY-HOLD                       SQ1344.2
046500         MOVE    SPACE TO DUMMY-RECORD                            SQ1344.2
046600         WRITE   DUMMY-RECORD AFTER ADVANCING PAGE                SQ1344.2
046700         MOVE    CCVS-C-1 TO DUMMY-RECORD PERFORM DECL-WRT-LN     SQ1344.2
046800         MOVE    CCVS-C-2 TO DUMMY-RECORD                         SQ1344.2
046900         PERFORM DECL-WRT-LN 2 TIMES                              SQ1344.2
047000         MOVE    HYPHEN-LINE TO DUMMY-RECORD                      SQ1344.2
047100         PERFORM DECL-WRT-LN                                      SQ1344.2
047200         MOVE    DUMMY-HOLD TO DUMMY-RECORD                       SQ1344.2
047300         MOVE    ZERO TO RECORD-COUNT.                            SQ1344.2
047400     PERFORM DECL-WRT-LN.                                         SQ1344.2
047500*                                                                 SQ1344.2
047600 DECL-WRT-LN.                                                     SQ1344.2
047700     WRITE   DUMMY-RECORD AFTER ADVANCING 1 LINES.                SQ1344.2
047800     MOVE    SPACE TO DUMMY-RECORD.                               SQ1344.2
047900*                                                                 SQ1344.2
048000 DECL-FAIL-ROUTINE.                                               SQ1344.2
048100     IF COMPUTED-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE.      SQ1344.2
048200     IF CORRECT-X NOT EQUAL TO SPACE GO TO DECL-FAIL-WRITE.       SQ1344.2
048300     MOVE    ANSI-REFERENCE TO INF-ANSI-REFERENCE.                SQ1344.2
048400     MOVE   "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT.  SQ1344.2
048500     MOVE    XXINFO TO DUMMY-RECORD.                              SQ1344.2
048600     PERFORM DECL-WRITE-LINE 2 TIMES.                             SQ1344.2
048700     MOVE    SPACES TO INF-ANSI-REFERENCE.                        SQ1344.2
048800     GO TO   DECL-FAIL-EX.                                        SQ1344.2
048900 DECL-FAIL-WRITE.                                                 SQ1344.2
049000     MOVE    TEST-COMPUTED TO PRINT-REC                           SQ1344.2
049100     PERFORM DECL-WRITE-LINE                                      SQ1344.2
049200     MOVE    ANSI-REFERENCE TO COR-ANSI-REFERENCE.                SQ1344.2
049300     MOVE    TEST-CORRECT TO PRINT-REC                            SQ1344.2
049400     PERFORM DECL-WRITE-LINE 2 TIMES.                             SQ1344.2
049500     MOVE    SPACES TO COR-ANSI-REFERENCE.                        SQ1344.2
049600 DECL-FAIL-EX.                                                    SQ1344.2
049700     EXIT.                                                        SQ1344.2
049800*                                                                 SQ1344.2
049900 DECL-BAIL.                                                       SQ1344.2
050000     IF COMPUTED-A NOT EQUAL TO SPACE GO TO DECL-BAIL-WRITE.      SQ1344.2
050100     IF CORRECT-A EQUAL TO SPACE GO TO DECL-BAIL-EX.              SQ1344.2
050200 DECL-BAIL-WRITE.                                                 SQ1344.2
050300     MOVE    CORRECT-A TO XXCORRECT.                              SQ1344.2
050400     MOVE    COMPUTED-A TO XXCOMPUTED.                            SQ1344.2
050500     MOVE    XXINFO TO DUMMY-RECORD.                              SQ1344.2
050600     PERFORM DECL-WRITE-LINE 2 TIMES.                             SQ1344.2
050700 DECL-BAIL-EX.                                                    SQ1344.2
050800     EXIT.                                                        SQ1344.2
050900*                                                                 SQ1344.2
051000 END-DECLS.                                                       SQ1344.2
051100 END DECLARATIVES.                                                SQ1344.2
051200*                                                                 SQ1344.2
051300*                                                                 SQ1344.2
051400 CCVS1 SECTION.                                                   SQ1344.2
051500 OPEN-FILES.                                                      SQ1344.2
051600     OPEN    I-O RAW-DATA.                                        SQ1344.2
051700     MOVE    CCVS-PGM-ID TO RAW-DATA-KEY.                         SQ1344.2
051800     READ    RAW-DATA INVALID KEY GO TO END-E-1.                  SQ1344.2
051900     MOVE   "ABORTED "   TO C-ABORT.                              SQ1344.2
052000     ADD     1           TO C-NO-OF-TESTS.                        SQ1344.2
052100     ACCEPT  C-DATE      FROM DATE.                               SQ1344.2
052200     ACCEPT  C-TIME      FROM TIME.                               SQ1344.2
052300     REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE.                  SQ1344.2
052400 END-E-1.                                                         SQ1344.2
052500     CLOSE   RAW-DATA.                                            SQ1344.2
052600     OPEN    OUTPUT PRINT-FILE.                                   SQ1344.2
052700     MOVE    CCVS-PGM-ID TO TEST-ID.                              SQ1344.2
052800     MOVE    CCVS-PGM-ID TO ID-AGAIN.                             SQ1344.2
052900     MOVE    SPACE TO TEST-RESULTS.                               SQ1344.2
053000     PERFORM HEAD-ROUTINE THRU COLUMN-NAMES-ROUTINE.              SQ1344.2
053100     MOVE    ZERO TO REC-SKEL-SUB.                                SQ1344.2
053200     PERFORM CCVS-INIT-FILE 10 TIMES.                             SQ1344.2
053300     GO TO CCVS1-EXIT.                                            SQ1344.2
053400*                                                                 SQ1344.2
053500 CCVS-INIT-FILE.                                                  SQ1344.2
053600     ADD     1 TO REC-SKL-SUB.                                    SQ1344.2
053700     MOVE    FILE-RECORD-INFO-SKELETON TO                         SQ1344.2
053800                  FILE-RECORD-INFO (REC-SKL-SUB).                 SQ1344.2
053900*                                                                 SQ1344.2
054000 CLOSE-FILES.                                                     SQ1344.2
054100     PERFORM END-ROUTINE THRU END-ROUTINE-13.                     SQ1344.2
054200     CLOSE   PRINT-FILE.                                          SQ1344.2
054300     OPEN    I-O RAW-DATA.                                        SQ1344.2
054400     MOVE    CCVS-PGM-ID TO RAW-DATA-KEY.                         SQ1344.2
054500     READ    RAW-DATA INVALID KEY GO TO END-E-2.                  SQ1344.2
054600     MOVE   "OK. " TO C-ABORT.                                SQ1344.2
054700     MOVE    PASS-COUNTER  TO C-OK.                               SQ1344.2
054800     MOVE    ERROR-HOLD    TO C-ALL.                              SQ1344.2
054900     MOVE    ERROR-COUNTER TO C-FAIL.                             SQ1344.2
055000     MOVE    DELETE-CNT    TO C-DELETED.                          SQ1344.2
055100     MOVE    INSPECT-COUNTER TO C-INSPECT.                        SQ1344.2
055200     REWRITE RAW-DATA-SATZ INVALID KEY CONTINUE.                  SQ1344.2
055300 END-E-2.                                                         SQ1344.2
055400     CLOSE   RAW-DATA.                                            SQ1344.2
055500 TERMINATE-CCVS.                                                  SQ1344.2
055600     EXIT    PROGRAM.                                             SQ1344.2
055700     STOP    RUN.                                                 SQ1344.2
055800*                                                                 SQ1344.2
055900 INSPT.                                                           SQ1344.2
056000     MOVE   "INSPT" TO P-OR-F.                                    SQ1344.2
056100     ADD     1 TO INSPECT-COUNTER.                                SQ1344.2
056200     PERFORM PRINT-DETAIL.                                        SQ1344.2
056300*                                                                 SQ1344.2
056400 PASS.                                                            SQ1344.2
056500     MOVE   "PASS " TO P-OR-F.                                    SQ1344.2
056600     ADD     1 TO PASS-COUNTER.                                   SQ1344.2
056700     PERFORM PRINT-DETAIL.                                        SQ1344.2
056800*                                                                 SQ1344.2
056900 FAIL.                                                            SQ1344.2
057000     MOVE   "FAIL*" TO P-OR-F.                                    SQ1344.2
057100     ADD     1 TO ERROR-COUNTER.                                  SQ1344.2
057200     PERFORM PRINT-DETAIL.                                        SQ1344.2
057300*                                                                 SQ1344.2
057400 DE-LETE.                                                         SQ1344.2
057500     MOVE   "****TEST DELETED****" TO RE-MARK.                    SQ1344.2
057600     MOVE   "*****" TO P-OR-F.                                    SQ1344.2
057700     ADD     1 TO DELETE-COUNTER.                                 SQ1344.2
057800     PERFORM PRINT-DETAIL.                                        SQ1344.2
057900*                                                                 SQ1344.2
058000 PRINT-DETAIL.                                                    SQ1344.2
058100     IF REC-CT NOT EQUAL TO ZERO                                  SQ1344.2
058200         MOVE   "." TO PARDOT-X                                   SQ1344.2
058300         MOVE    REC-CT TO DOTVALUE.                              SQ1344.2
058400     MOVE    TEST-RESULTS TO PRINT-REC.                           SQ1344.2
058500     PERFORM WRITE-LINE.                                          SQ1344.2
058600     IF P-OR-F EQUAL TO "FAIL*"                                   SQ1344.2
058700         PERFORM WRITE-LINE                                       SQ1344.2
058800         PERFORM FAIL-ROUTINE THRU FAIL-ROUTINE-EX                SQ1344.2
058900     ELSE                                                         SQ1344.2
059000         PERFORM BAIL-OUT THRU BAIL-OUT-EX.                       SQ1344.2
059100     MOVE    SPACE TO P-OR-F.                                     SQ1344.2
059200     MOVE    SPACE TO COMPUTED-X.                                 SQ1344.2
059300     MOVE    SPACE TO CORRECT-X.                                  SQ1344.2
059400     IF REC-CT EQUAL TO ZERO  MOVE SPACE TO PAR-NAME.             SQ1344.2
059500     MOVE    SPACE TO RE-MARK.                                    SQ1344.2
059600*                                                                 SQ1344.2
059700 HEAD-ROUTINE.                                                    SQ1344.2
059800     MOVE CCVS-H-1  TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES.  SQ1344.2
059900     MOVE CCVS-H-2A TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES.  SQ1344.2
060000     MOVE CCVS-H-2B TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES.  SQ1344.2
060100     MOVE CCVS-H-3  TO DUMMY-RECORD. PERFORM WRITE-LINE 3 TIMES.  SQ1344.2
060200 COLUMN-NAMES-ROUTINE.                                            SQ1344.2
060300     MOVE CCVS-C-1 TO DUMMY-RECORD. PERFORM WRITE-LINE.           SQ1344.2
060400     MOVE CCVS-C-2 TO DUMMY-RECORD. PERFORM WRITE-LINE 2 TIMES.   SQ1344.2
060500     MOVE HYPHEN-LINE TO DUMMY-RECORD. PERFORM WRITE-LINE.        SQ1344.2
060600 END-ROUTINE.                                                     SQ1344.2
060700     MOVE    HYPHEN-LINE TO DUMMY-RECORD.                         SQ1344.2
060800     PERFORM WRITE-LINE 5 TIMES.                                  SQ1344.2
060900 END-RTN-EXIT.                                                    SQ1344.2
061000     MOVE    CCVS-E-1 TO DUMMY-RECORD.                            SQ1344.2
061100     PERFORM WRITE-LINE 2 TIMES.                                  SQ1344.2
061200*                                                                 SQ1344.2
061300 END-ROUTINE-1.                                                   SQ1344.2
061400     ADD     ERROR-COUNTER   TO ERROR-HOLD                        SQ1344.2
061500     ADD     INSPECT-COUNTER TO ERROR-HOLD.                       SQ1344.2
061600     ADD     DELETE-COUNTER  TO ERROR-HOLD.                       SQ1344.2
061700     ADD     PASS-COUNTER    TO ERROR-HOLD.                       SQ1344.2
061800     MOVE    PASS-COUNTER    TO CCVS-E-4-1.                       SQ1344.2
061900     MOVE    ERROR-HOLD      TO CCVS-E-4-2.                       SQ1344.2
062000     MOVE    CCVS-E-4        TO CCVS-E-2-2.                       SQ1344.2
062100     MOVE    CCVS-E-2        TO DUMMY-RECORD                      SQ1344.2
062200     PERFORM WRITE-LINE.                                          SQ1344.2
062300     MOVE   "TEST(S) FAILED" TO ENDER-DESC.                       SQ1344.2
062400     IF ERROR-COUNTER IS EQUAL TO ZERO                            SQ1344.2
062500         MOVE   "NO " TO ERROR-TOTAL                              SQ1344.2
062600     ELSE                                                         SQ1344.2
062700         MOVE    ERROR-COUNTER TO ERROR-TOTAL.                    SQ1344.2
062800     MOVE    CCVS-E-2 TO DUMMY-RECORD.                            SQ1344.2
062900     PERFORM WRITE-LINE.                                          SQ1344.2
063000 END-ROUTINE-13.                                                  SQ1344.2
063100     IF DELETE-COUNTER IS EQUAL TO ZERO                           SQ1344.2
063200         MOVE   "NO " TO ERROR-TOTAL                              SQ1344.2
063300     ELSE                                                         SQ1344.2
063400         MOVE    DELETE-COUNTER TO ERROR-TOTAL.                   SQ1344.2
063500     MOVE   "TEST(S) DELETED " TO ENDER-DESC.                 SQ1344.2
063600     MOVE    CCVS-E-2 TO DUMMY-RECORD.                            SQ1344.2
063700     PERFORM WRITE-LINE.                                          SQ1344.2
063800     IF INSPECT-COUNTER EQUAL TO ZERO                             SQ1344.2
063900         MOVE   "NO " TO ERROR-TOTAL                              SQ1344.2
064000     ELSE                                                         SQ1344.2
064100         MOVE    INSPECT-COUNTER TO ERROR-TOTAL.                  SQ1344.2
064200     MOVE   "TEST(S) REQUIRE INSPECTION" TO ENDER-DESC.           SQ1344.2
064300     MOVE    CCVS-E-2 TO DUMMY-RECORD. PERFORM WRITE-LINE.        SQ1344.2
064400     MOVE    CCVS-E-3 TO DUMMY-RECORD. PERFORM WRITE-LINE.        SQ1344.2
064500*                                                                 SQ1344.2
064600 WRITE-LINE.                                                      SQ1344.2
064700     ADD     1 TO RECORD-COUNT.                                   SQ1344.2
064800     IF RECORD-COUNT GREATER 50                                   SQ1344.2
064900         MOVE  DUMMY-RECORD TO DUMMY-HOLD                         SQ1344.2
065000         MOVE  SPACE TO DUMMY-RECORD                              SQ1344.2
065100         WRITE DUMMY-RECORD AFTER ADVANCING PAGE                  SQ1344.2
065200         MOVE  CCVS-C-1 TO DUMMY-RECORD PERFORM WRT-LN            SQ1344.2
065300         MOVE  CCVS-C-2 TO DUMMY-RECORD PERFORM WRT-LN 2 TIMES    SQ1344.2
065400         MOVE  HYPHEN-LINE TO DUMMY-RECORD PERFORM WRT-LN         SQ1344.2
065500         MOVE  DUMMY-HOLD TO DUMMY-RECORD                         SQ1344.2
065600         MOVE  ZERO TO RECORD-COUNT.                              SQ1344.2
065700     PERFORM WRT-LN.                                              SQ1344.2
065800*                                                                 SQ1344.2
065900 WRT-LN.                                                          SQ1344.2
066000     WRITE   DUMMY-RECORD AFTER ADVANCING 1 LINES.                SQ1344.2
066100     MOVE    SPACE TO DUMMY-RECORD.                               SQ1344.2
066200 BLANK-LINE-PRINT.                                                SQ1344.2
066300     PERFORM WRT-LN.                                              SQ1344.2
066400 FAIL-ROUTINE.                                                    SQ1344.2
066500     IF COMPUTED-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.   SQ1344.2
066600     IF CORRECT-X NOT EQUAL TO SPACE GO TO FAIL-ROUTINE-WRITE.    SQ1344.2
066700     MOVE    ANSI-REFERENCE TO INF-ANSI-REFERENCE.                SQ1344.2
066800     MOVE   "NO FURTHER INFORMATION, SEE PROGRAM." TO INFO-TEXT.  SQ1344.2
066900     MOVE    XXINFO TO DUMMY-RECORD.                              SQ1344.2
067000     PERFORM WRITE-LINE 2 TIMES.                                  SQ1344.2
067100     MOVE    SPACES TO INF-ANSI-REFERENCE.                        SQ1344.2
067200     GO TO   FAIL-ROUTINE-EX.                                     SQ1344.2
067300 FAIL-ROUTINE-WRITE.                                              SQ1344.2
067400     MOVE    TEST-COMPUTED  TO PRINT-REC                          SQ1344.2
067500     PERFORM WRITE-LINE                                           SQ1344.2
067600     MOVE    ANSI-REFERENCE TO COR-ANSI-REFERENCE.                SQ1344.2
067700     MOVE    TEST-CORRECT   TO PRINT-REC                          SQ1344.2
067800     PERFORM WRITE-LINE 2 TIMES.                                  SQ1344.2
067900     MOVE    SPACES         TO COR-ANSI-REFERENCE.                SQ1344.2
068000 FAIL-ROUTINE-EX.                                                 SQ1344.2
068100     EXIT.                                                        SQ1344.2
068200 BAIL-OUT.                                                        SQ1344.2
068300     IF COMPUTED-A NOT EQUAL TO SPACE GO TO BAIL-OUT-WRITE.       SQ1344.2
068400     IF CORRECT-A EQUAL TO SPACE GO TO BAIL-OUT-EX.               SQ1344.2
068500 BAIL-OUT-WRITE.                                                  SQ1344.2
068600     MOVE    CORRECT-A      TO XXCORRECT.                         SQ1344.2
068700     MOVE    COMPUTED-A     TO XXCOMPUTED.                        SQ1344.2
068800     MOVE    ANSI-REFERENCE TO INF-ANSI-REFERENCE.                SQ1344.2
068900     MOVE    XXINFO TO DUMMY-RECORD.                              SQ1344.2
069000     PERFORM WRITE-LINE 2 TIMES.                                  SQ1344.2
069100     MOVE    SPACES TO INF-ANSI-REFERENCE.                        SQ1344.2
069200 BAIL-OUT-EX.                                                     SQ1344.2
069300     EXIT.                                                        SQ1344.2
069400 CCVS1-EXIT.                                                      SQ1344.2
069500     EXIT.                                                        SQ1344.2
069600*                                                                 SQ1344.2
069700****************************************************************  SQ1344.2
069800*                                                              *  SQ1344.2
069900*    THIS POINT MARKS THE END OF THE CCVS MONITOR ROUTINES AND *  SQ1344.2
070000*    THE START OF THE TESTS OF SPECIFIC COBOL FEATURES.        *  SQ1344.2
070100*                                                              *  SQ1344.2
070200****************************************************************  SQ1344.2
070300*                                                                 SQ1344.2
070400 SECT-SQ134A-0002 SECTION.                                        SQ1344.2
070500 STA-INIT.                                                        SQ1344.2
070600     MOVE    SPACE TO DELETE-SW.                                  SQ1344.2
070700*                                                                 SQ1344.2
070800     MOVE   "SQ-FS4" TO XFILE-NAME (1).                           SQ1344.2
070900     MOVE   "R1-F-G" TO XRECORD-NAME (1).                         SQ1344.2
071000     MOVE    CCVS-PGM-ID TO XPROGRAM-NAME (1).                    SQ1344.2
071100     MOVE    120 TO XRECORD-LENGTH (1).                           SQ1344.2
071200     MOVE   "CC" TO CHARS-OR-RECORDS (1).                         SQ1344.2
071300     MOVE    1   TO XBLOCK-SIZE (1).                              SQ1344.2
071400     MOVE    1   TO RECORDS-IN-FILE (1).                          SQ1344.2
071500     MOVE   "SQ" TO XFILE-ORGANIZATION (1).                       SQ1344.2
071600     MOVE   "S"  TO XLABEL-TYPE (1).                              SQ1344.2
071700*                                                                 SQ1344.2
071800*    OPEN THE FILE IN THE OUTPUT MODE                             SQ1344.2
071900*                                                                 SQ1344.2
072000 SEQ-INIT-01.                                                     SQ1344.2
072100     MOVE    0 TO REC-CT.                                         SQ1344.2
072200     MOVE   "*" TO DECL-EXEC-SW.                                  SQ1344.2
072300     MOVE   "**" TO SQ-FS4-STATUS.                                SQ1344.2
072400     MOVE   "NOT EXECUTED" TO DECL-EXEC-I-O.                      SQ1344.2
072500     MOVE    ZERO TO XRECORD-NUMBER (1).                          SQ1344.2
072600     MOVE   "OPEN, CREATE FILE"  TO FEATURE.                      SQ1344.2
072700     MOVE   "SEQ-TEST-OP-01" TO PAR-NAME.                         SQ1344.2
072800     GO TO   SEQ-TEST-OP-01.                                      SQ1344.2
072900 SEQ-DELETE-01.                                                   SQ1344.2
073000     MOVE   "*" TO DELETE-SW-1.                                   SQ1344.2
073100     GO TO   SEQ-DELETE-01-01.                                    SQ1344.2
073200 SEQ-TEST-OP-01.                                                  SQ1344.2
073300     OPEN    OUTPUT SQ-FS4.                                       SQ1344.2
073400*                                                                 SQ1344.2
073500*    CHECK I-O STATUS RETURNED FROM OPEN OUTPUT                   SQ1344.2
073600*                                                                 SQ1344.2
073700     ADD    1 TO REC-CT.                                          SQ1344.2
073800     IF DELETE-SW NOT = SPACE                                     SQ1344.2
073900         GO TO   SEQ-DELETE-01-01.                                SQ1344.2
074000     GO TO   SEQ-TEST-OP-01-01.                                   SQ1344.2
074100 SEQ-DELETE-01-01.                                                SQ1344.2
074200     PERFORM DE-LETE.                                             SQ1344.2
074300     GO TO   SEQ-TEST-01-01-END.                                  SQ1344.2
074400 SEQ-TEST-OP-01-01.                                               SQ1344.2
074500     IF SQ-FS4-STATUS = "00"                                      SQ1344.2
074600         PERFORM PASS                                             SQ1344.2
074700     ELSE                                                         SQ1344.2
074800         MOVE    SQ-FS4-STATUS TO COMPUTED-A                      SQ1344.2
074900         MOVE   "00" TO CORRECT-A                                 SQ1344.2
075000         MOVE   "UNEXPECTED ERROR CODE FROM OPEN OUTPUT"          SQ1344.2
075100                   TO RE-MARK                                     SQ1344.2
075200         MOVE   "VII-3, VII-43" TO ANSI-REFERENCE                 SQ1344.2
075300         PERFORM FAIL.                                            SQ1344.2
075400 SEQ-TEST-01-01-END.                                              SQ1344.2
075500*                                                                 SQ1344.2
075600*    CHECK EXECUTION OF I-O DECLARATIVE                           SQ1344.2
075700*                                                                 SQ1344.2
075800     ADD     1 TO REC-CT.                                         SQ1344.2
075900     IF DELETE-SW NOT = SPACE                                     SQ1344.2
076000         GO TO   SEQ-DELETE-01-02.                                SQ1344.2
076100     GO TO   SEQ-TEST-OP-01-02.                                   SQ1344.2
076200 SEQ-DELETE-01-02.                                                SQ1344.2
076300     PERFORM DE-LETE.                                             SQ1344.2
076400     GO TO   SEQ-TEST-01-02-END.                                  SQ1344.2
076500 SEQ-TEST-OP-01-02.                                               SQ1344.2
076600     IF DECL-EXEC-I-O = "NOT EXECUTED"                            SQ1344.2
076700         PERFORM PASS                                             SQ1344.2
076800     ELSE                                                         SQ1344.2
076900         MOVE    DECL-EXEC-I-O TO COMPUTED-A                      SQ1344.2
077000         MOVE   "NOT EXECUTED" TO CORRECT-A                       SQ1344.2
077100         MOVE   "UNEXPECTED EXECUTION OF I-O DECLARATIVE"         SQ1344.2
077200                   TO RE-MARK                                     SQ1344.2
077300         MOVE   "VII-2,1.3.5, VII-51,4.6.4(5)" TO ANSI-REFERENCE  SQ1344.2
077400         PERFORM FAIL.                                            SQ1344.2
077500 SEQ-TEST-01-02-END.                                              SQ1344.2
077600*                                                                 SQ1344.2
077700*                                                                 SQ1344.2
077800*    A NEW FILE IS OPEN.  WE NOW WRITE ONE RECORD OF 138 CHARS.   SQ1344.2
077900*                                                                 SQ1344.2
078000 SEQ-INIT-02.                                                     SQ1344.2
078100     MOVE    0 TO REC-CT.                                         SQ1344.2
078200     MOVE   "*" TO DECL-EXEC-SW.                                  SQ1344.2
078300     ADD     1 TO XRECORD-NUMBER (1).                             SQ1344.2
078400     MOVE   "**" TO SQ-FS4-STATUS.                                SQ1344.2
078500     MOVE   "NOT EXECUTED" TO DECL-EXEC-I-O.                      SQ1344.2
078600     MOVE   "WRITE A RECORD"  TO FEATURE.                         SQ1344.2
078700     MOVE   "SEQ-TEST-WR-02" TO PAR-NAME.                         SQ1344.2
078800     IF DELETE-SW NOT EQUAL TO SPACE                              SQ1344.2
078900         GO TO SEQ-DELETE-02.                                     SQ1344.2
079000     GO TO   SEQ-TEST-WR-02.                                      SQ1344.2
079100 SEQ-DELETE-02.                                                   SQ1344.2
079200     MOVE   "*" TO DELETE-SW-2.                                   SQ1344.2
079300     GO TO   SEQ-DELETE-02-01.                                    SQ1344.2
079400 SEQ-TEST-WR-02.                                                  SQ1344.2
079500     MOVE    FILE-RECORD-INFO-P1-120 (1) TO SQ-FS4R1-F-G-120.     SQ1344.2
079600     MOVE   "987654321123456789" TO EXT-18.                       SQ1344.2
079700     WRITE   SQ-FS4R2-F-G-138.                                    SQ1344.2
079800*                                                                 SQ1344.2
079900*    CHECK I-O STATUS RETURNED FROM WRITE                         SQ1344.2
080000*                                                                 SQ1344.2
080100     ADD    1 TO REC-CT.                                          SQ1344.2
080200     IF DELETE-SW NOT = SPACE                                     SQ1344.2
080300         GO TO   SEQ-DELETE-02-01.                                SQ1344.2
080400     GO TO   SEQ-TEST-WR-02-01.                                   SQ1344.2
080500 SEQ-DELETE-02-01.                                                SQ1344.2
080600     PERFORM DE-LETE.                                             SQ1344.2
080700     GO TO   SEQ-TEST-02-01-END.                                  SQ1344.2
080800 SEQ-TEST-WR-02-01.                                               SQ1344.2
080900     IF SQ-FS4-STATUS = "00"                                      SQ1344.2
--> --------------------

--> maximum size reached

--> --------------------

95%


¤ 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.0.42Bemerkung:  (vorverarbeitet)  ¤

*Bot Zugriff




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.