Quelle dml074.cob Sprache: Cobol

       IDENTIFICATION DIVISION.
       PROGRAM-ID.  DML074.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SOURCE-COMPUTER.  xyz.
       OBJECT-COMPUTER.  xyz.
       DATA DIVISION.
       WORKING-STORAGE SECTION.

      * Standard COBOL (file "DML074.SCO") calling SQL
      * procedures in file "DML074.MCO".

      * STANDARD COBOL (file "DML074.SCO")

      ****************************************************************
      *
      *                 COMMENT SECTION
      *
      * DATE 1991/26/06 STANDARD COBOL LANGUAGE
      * NIST SQL VALIDATION TEST SUITE V6.0
      *  DISCLAIMER:
      *  This program was written by employees of NIST to test SQL
      *  implementations for conformance to the SQL standards.
      *  NIST assumes no responsibility for any party's use of
      *  this program.
      *
      * DML074.SCO
      * WRITTEN BY: YOLANDA HERD
      *
      * THIS ROUTINE TESTS MODULE LANGUAGE PARAMETERS
      *
      * REFERENCES
      *       AMERICAN NATIONAL STANDARD database language - SQL
      *                         X3.135-1989
      *
      *                         SECTION 4.9 <Procedures>
      *                         SECTION 7.3 <Procedures>
      ****************************************************************

      * EXEC SQL BEGIN DECLARE SECTION END-EXEC
       01  ENUM-TABLE.
           05  ENUM PIC  X(3) OCCURS 3 TIMES.
       01  ENAME PIC  X(20).
       01  ENUM1 PIC X(3).
       01  CTY PIC  X(15).
       01  CITY20 PIC X(20).
       01  TMP1 PIC  X(3).
       01  TMP2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  GRDE PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  CODE5 PIC S9(9) COMP.
       01  SQLCD1 PIC S9(9) COMP.
       01  S2 PIC S9(9) COMP.
       01  SQLCODE PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  errcnt PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
      *  EXEC SQL END DECLARE SECTION END-EXEC
       01  uid PIC  X(18).
       01  uidx PIC X(18).
       01  flag1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.

       01  SQL-COD PIC S9(9) DISPLAY SIGN LEADING SEPARATE.

      * date_time declaration *
       01  TO-DAY PIC 9(6).
       01  THE-TIME PIC 9(8).

       PROCEDURE DIVISION.
       P0.

             MOVE "HU" TO uid
             CALL "AUTHID" USING uid
           MOVE "not logged in, not" TO uidx
           CALL "AUTHCK" USING SQLCD1 uidx
           MOVE SQLCD1 TO SQL-COD
           if (uid NOT = uidx) then
            DISPLAY "ERROR: User " uid " expected."
            DISPLAY "User " uidx " connected."
            DISPLAY " "
            STOP RUN
           END-IF

           MOVE 0 TO errcnt
           DISPLAY
           "SQL Test Suite, V6.0, Module COBOL, dml074.sco"
           DISPLAY " "
           DISPLAY
           "59-byte ID"
           DISPLAY "TEd Version #"
           DISPLAY " "
      * date_time print *
           ACCEPT TO-DAY FROM DATE
           ACCEPT THE-TIME FROM TIME
           DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIME

      ******************** BEGIN TEST0421 *******************

             DISPLAY " OPTIONAL TEST0421 "
             DISPLAY " Module language constants and expressions"
             DISPLAY " references Section 7.3 SR8 data types "
             DISPLAY " - - - - - - - - - - - - - - - - - - - - - -"
             DISPLAY " NOTE: THIS TEST IS OPTIONAL "

             MOVE "Carmen" TO ENAME
             MOVE 0 TO TMP2

      *  EXEC SQL SELECT GRADE INTO :TMP2
      *    FROM STAFF
      *    WHERE EMPNAME = :ENAME;
             CALL "SUB1" USING SQLCD1 TMP2 "Carmen "

             MOVE "E11" TO ENUM(1)
             MOVE "E6 " TO ENUM(2)
             MOVE "E33" TO ENUM(3)
             MOVE "Yolanda" TO ENAME
             MOVE "Woodbridge" TO CTY
             MOVE 23 TO GRDE
             MOVE "XXX" TO TMP1

      *  EXEC SQL INSERT INTO STAFF
      *    VALUES(:ENUM,:ENAME,:GRDE,:CTY);
             CALL "SUB2" USING SQLCD1 ENUM(2) "Yolanda "
                               GRDE CTY

             MOVE " Woodbridge" TO CITY20

             DISPLAY " "
             DISPLAY " ENUM(2) = ", ENUM(2)
             DISPLAY " CITY20(4:10) = ", CITY20(4:10)
             DISPLAY " ENAME = ", ENAME
             DISPLAY " GRDE = ", GRDE

      *  EXEC SQL SELECT EMPNUM INTO :TMP1
      *    FROM STAFF
      *    WHERE EMPNAME = :ENAME AND GRADE = :GRDE
      *    AND CITY = :CTY;

             CALL "SUB3" USING SQLCD1 TMP1 ENAME GRDE CITY20(4:10)
             MOVE SQLCD1 TO SQL-COD
             DISPLAY " SQLCD1 = ", SQL-COD
             DISPLAY " TMP1 = ", TMP1

      *  EXEC SQL ROLLBACK WORK;
             CALL "SUB4" USING SQLCD1

             DISPLAY " "
             DISPLAY " The correct answers are:"
             DISPLAY " TMP1 = E6, TMP2 = 13"
             DISPLAY  " "
             DISPLAY " Your answers are:"
             DISPLAY " TMP1 = ", TMP1 ", TMP2 = ", TMP2

             if ((TMP1   =   "E6 ")  AND  TMP2  =  13) then
               DISPLAY " *** pass *** "
      *    EXEC SQL INSERT INTO TESTREPORT
      *      VALUES('0421','pass','MCO');
               CALL "SUB5" USING SQLCD1
             else
               DISPLAY " dml074.sco *** fail *** "
      *    EXEC SQL INSERT INTO TESTREPORT
      *      VALUES('0421','fail','MCO');
             ADD 1 TO errcnt
               CALL "SUB6" USING SQLCD1
             END-IF
      *  EXEC SQL COMMIT WORK;
             CALL "SUB7" USING SQLCD1

             DISPLAY
             "=================================================="
             DISPLAY  " "

      ******************** END TEST0421 *******************

      ******************** BEGIN TEST0422 *******************

             DISPLAY " TEST0422 "
             DISPLAY " Module language order of SQLCD1 (not first)"
             DISPLAY " references Section 7.3 SR5 and SR6 "
             DISPLAY " - - - - - - - - - - - - - - - - - - - - - - - -
      -    " -"

             MOVE "XXX" TO TMP1
             MOVE "XX" TO ENUM1
             MOVE "XXXXX" TO ENAME
             MOVE "XXXXX" TO CTY
             MOVE 0 TO GRDE
             MOVE 0 TO TMP2

      *  EXEC SQL SELECT EMPNUM, EMPNAME, GRADE, CITY
      *    INTO :TMP1, :ENAME, :TMP2, :CTY
      *    FROM STAFF
      *    WHERE EMPNAME = 'Alice';
             CALL "SUB8" USING TMP1 SQLCD1 ENAME TMP2 CTY

      *  EXEC SQL SELECT EMPNUM, EMPNAME, GRADE, CITY
      *    INTO :ENUM1, :ENAME, :GRDE, :CTY
      *    FROM STAFF
      *    WHERE CITY = 'Akron';
             CALL "SUB9" USING CTY ENUM1 ENAME GRDE SQLCD1

             DISPLAY " The correct answers are:"
             DISPLAY " TMP1 = E1, TMP2 = 12"
             DISPLAY " ENUM1 = E5, ENAME = Ed"
             DISPLAY  " "
             DISPLAY " Your answers are:"
             DISPLAY " TMP1 = ", TMP1 ", TMP2 = ", TMP2
             DISPLAY " ENUM1 = ", ENUM1 ", ENAME = ", ENAME

             MOVE 0 TO flag1

             if ((TMP1  NOT  =   "E1 ")
             AND  (ENUM1  NOT =  "E5 ")) then
               MOVE 1 TO flag1
             END-IF

             if ((ENAME NOT = "Ed ") AND
             (TMP2 NOT = 12)) then
               MOVE 1 TO flag1
             END-IF

             if (flag1  =  0) then
               DISPLAY " *** pass *** "
      *    EXEC SQL INSERT INTO TESTREPORT
      *      VALUES('0422','pass','MCO');
               CALL "SUB10" USING SQLCD1
             else
               DISPLAY " dml074.sco *** fail *** "
      *    EXEC SQL INSERT INTO TESTREPORT
      *      VALUES('0422','fail','MCO');
             ADD 1 TO errcnt
               CALL "SUB11" USING SQLCD1
             END-IF
      *  EXEC SQL COMMIT WORK;
             CALL "SUB12" USING SQLCD1
             DISPLAY
             "=================================================="

             DISPLAY  " "

      ******************** END TEST0422 *******************

      ******************** BEGIN TEST0423 *******************

             DISPLAY " TEST0423 "
             DISPLAY " Module language multiple host language SQLCODE
      -    " parameters"
             DISPLAY " references Section 7.3 SR5 and SR6 "
             DISPLAY " - - - - - - - - - - - - - - - - - - - -"

             MOVE -1 TO CODE5
             MOVE -1 TO SQLCD1
             MOVE -1 TO S2

             DISPLAY " The correct answers are:"
             DISPLAY " CODE5 = 0, SQLCD1 = 0"
             DISPLAY " S2 = 0, SQLCODE = 12"
             DISPLAY  " "
             DISPLAY " Your answers are:"

      *  EXEC SQL SELECT COUNT(*) INTO :SQLCODE
      *    FROM STAFF;
             CALL "SUB13" USING CODE5 SQLCODE
             MOVE CODE5 TO SQL-COD
             DISPLAY " CODE5 = ", SQL-COD

      *  EXEC SQL SELECT COUNT(*) INTO :SQLCODE
      *    FROM PROJ;
             CALL "SUB14" USING SQLCD1 SQLCODE
             MOVE SQLCD1 TO SQL-COD
             DISPLAY " SQLCD1 = ", SQL-COD

      *  EXEC SQL SELECT COUNT(*) INTO :SQLCODE
      *    FROM WORKS;
             CALL "SUB15" USING S2 SQLCODE
             MOVE S2 TO SQL-COD
             DISPLAY " S2 = ", SQL-COD ", SQLCODE = ", SQLCODE

             if (CODE5  =  0  AND  SQLCD1  =  0  AND  S2  =  0  AND
             SQLCODE  =  12) then
               DISPLAY " *** pass *** "
      *    EXEC SQL INSERT INTO TESTREPORT
      *      VALUES('0423','pass','MCO');
               CALL "SUB16" USING SQLCD1
               MOVE SQLCD1 TO SQL-COD
             else
               DISPLAY " dml074.sco *** fail *** "
      *    EXEC SQL INSERT INTO TESTREPORT
      *      VALUES('0423','fail','MCO');
             ADD 1 TO errcnt
               CALL "SUB17" USING SQLCD1
               MOVE SQLCD1 TO SQL-COD
             END-IF
      *  EXEC SQL COMMIT WORK;
             CALL "SUB18" USING SQLCD1
             MOVE SQLCD1 TO SQL-COD
             DISPLAY
             "=================================================="

             DISPLAY  " "

      ******************** END TEST0423 *******************

      **** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0
           STOP RUN.

      *    ****  Procedures for PERFORM statements

quality100%

¤ Dauer der Verarbeitung: 0.12 Sekunden (vorverarbeitet) ¤

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.