Quelle sm208a.cob Sprache: Cobol

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

quality95%

¤ Dauer der Verarbeitung: 0.20 Sekunden ¤

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.