Quelle dml087.cob Sprache: Cobol

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

      * EMBEDDED COBOL (file "DML087.PCO")

      ****************************************************************
      *
      *                 COMMENT SECTION
      *
      * DATE 1992/08/01 EMBEDDED 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.
      *
      * DML087.PCO
      * WRITTEN BY: DAVID W. FLATER
      *
      *   THIS ROUTINE TESTS ENTRY LEVEL SQL.
      *
      * REFERENCES
      *   ANSI SQL-1992
      *
      ****************************************************************

           EXEC SQL BEGIN DECLARE SECTION END-EXEC
       01  uid PIC  X(18).
       01  uidx PIC  X(18).
       01  tmpcnt PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  cnt1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  cnt2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  cnt3 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  cnt4 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
             EXEC SQL END DECLARE SECTION END-EXEC
       01  SQLCODE PIC S9(9) COMP.
       01  errcnt PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
      *date_time declaration
       01  TO-DAY PIC 9(6).
       01  THE-TIME PIC 9(8).
       01  flag PIC S9(9) DISPLAY SIGN LEADING SEPARATE.

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

       PROCEDURE DIVISION.
       P0.

             MOVE "FLATER" TO uid
             CALL "AUTHID" USING uid
             MOVE "not logged in, not" TO uidx
             EXEC SQL SELECT USER INTO :uidx FROM HU.ECCO END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (uid  NOT  =   uidx) then
               DISPLAY "ERROR: User ", uid " expected. User ", uidx "
      -    " connected"
             STOP RUN
             END-IF
             MOVE 0 TO errcnt
             MOVE 1 TO flag

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

      ******************** BEGIN TEST0518 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0518 "
             DISPLAY " CREATE VIEW with DISTINCT"
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             DISPLAY " CREATE VIEW DV1 AS"
             DISPLAY " SELECT DISTINCT HOURS FROM HU.WORKS"
             DISPLAY  " "
             COMPUTE tmpcnt = -1
             DISPLAY "SELECT COUNT(*) FROM DV1;"
             EXEC SQL SELECT COUNT(*) INTO :tmpcnt FROM DV1 END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be 0; its value is ", SQL-COD
             DISPLAY "COUNT should be 4; its value is ", tmpcnt

             if (SQLCODE  NOT =  0  OR  tmpcnt  NOT =  4) then
               MOVE 0 TO flag
             END-IF

             DISPLAY  " "
             COMPUTE tmpcnt = -1
             MOVE 0 TO cnt1
             DISPLAY " DECLARE POIU CURSOR FOR"
             DISPLAY " SELECT HOURS FROM DV1"
             DISPLAY " ORDER BY HOURS DESC;"
             DISPLAY " OPEN POIU;"
             EXEC SQL DECLARE POIU CURSOR FOR
               SELECT HOURS2 FROM DV1
               ORDER BY HOURS2 DESC END-EXEC
             EXEC SQL OPEN POIU END-EXEC
             MOVE SQLCODE TO SQL-COD
             MOVE 1 TO cnt3
             PERFORM P50 UNTIL cnt3 > 5
             DISPLAY  " "
             DISPLAY "SQLCODE should be 100; its value is ", SQL-COD
             DISPLAY "COUNT should be 4; its value is ", tmpcnt

             if (tmpcnt  NOT =  4  OR  SQLCODE  NOT =  100) then
               MOVE 0 TO flag
             END-IF

             EXEC SQL ROLLBACK WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0518','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml087.pco *** fail *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0518','fail','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
             END-IF

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

             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
      ******************** END TEST0518 ********************

      ******************** BEGIN TEST0519 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0519 "
             DISPLAY " CREATE VIEW with subqueries"
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             DISPLAY " CREATE VIEW VS2 AS"
             DISPLAY " SELECT A.C1 FROM BASE_VS1 A WHERE EXISTS"
             DISPLAY " (SELECT B.C2 FROM BASE_VS1 B WHERE B.C2 =
      -    " A.C1)"
             DISPLAY  " "
             DISPLAY "SELECT COUNT(*) FROM VS2 WHERE C1 = 0;"
             EXEC SQL SELECT COUNT(*) INTO :tmpcnt
               FROM VS2 WHERE C1 = 0 END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be 0; its value is ", SQL-COD
             DISPLAY "COUNT should be 2; its value is ", tmpcnt

             if (SQLCODE  NOT =  0  OR  tmpcnt  NOT =  2) then
               MOVE 0 TO flag
             END-IF

             DISPLAY  " "
             DISPLAY "SELECT COUNT(*) FROM VS2 WHERE C1 = 1;"
             EXEC SQL SELECT COUNT(*) INTO :tmpcnt
               FROM VS2 WHERE C1 = 1 END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be 0; its value is ", SQL-COD
             DISPLAY "COUNT should be 2; its value is ", tmpcnt

             if (SQLCODE  NOT =  0  OR  tmpcnt  NOT =  2) then
               MOVE 0 TO flag
             END-IF

             DISPLAY  " "
             DISPLAY "CREATE VIEW VS3 AS"
             DISPLAY " SELECT A.C2 FROM BASE_VS1 A WHERE A.C2 IN"
             DISPLAY " (SELECT B.C1 FROM BASE_VS1 B WHERE B.C1 <
      -    " A.C2)"
             DISPLAY  " "
             DISPLAY "SELECT COUNT(*) FROM VS3;"
             EXEC SQL SELECT COUNT(*) INTO :tmpcnt
               FROM VS3 END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be 0; its value is ", SQL-COD
             DISPLAY "COUNT should be 0; its value is ", tmpcnt

             if (SQLCODE  NOT =  0  OR  tmpcnt  NOT =  0) then
               MOVE 0 TO flag
             END-IF

             DISPLAY  " "
             DISPLAY "CREATE VIEW VS4 AS"
             DISPLAY " SELECT A.C1 FROM BASE_VS1 A WHERE A.C1 < ALL"
             DISPLAY " (SELECT B.C2 FROM BASE_VS1 B)"
             DISPLAY  " "
             DISPLAY "SELECT COUNT(*) FROM VS4;"
             EXEC SQL SELECT COUNT(*) INTO :tmpcnt
               FROM VS4 END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be 0; its value is ", SQL-COD
             DISPLAY "COUNT should be 0; its value is ", tmpcnt

             if (SQLCODE  NOT =  0  OR  tmpcnt  NOT =  0) then
               MOVE 0 TO flag
             END-IF

             DISPLAY  " "
             DISPLAY "CREATE VIEW VS5 AS"
             DISPLAY " SELECT A.C1 FROM BASE_VS1 A WHERE A.C1 < SOME"
             DISPLAY " (SELECT B.C2 FROM BASE_VS1 B)"
             DISPLAY  " "
             DISPLAY "SELECT COUNT(*) FROM VS5;"
             EXEC SQL SELECT COUNT(*) INTO :tmpcnt
               FROM VS5 END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be 0; its value is ", SQL-COD
             DISPLAY "COUNT should be 2; its value is ", tmpcnt

             if (SQLCODE  NOT =  0  OR  tmpcnt  NOT =  2) then
               MOVE 0 TO flag
             END-IF

             DISPLAY  " "
             DISPLAY "CREATE VIEW VS6 AS"
             DISPLAY " SELECT A.C1 FROM BASE_VS1 A WHERE A.C1 < ANY"
             DISPLAY " (SELECT B.C2 FROM BASE_VS1 B)"
             DISPLAY  " "
             DISPLAY "SELECT COUNT(*) FROM VS6;"
             EXEC SQL SELECT COUNT(*) INTO :tmpcnt
               FROM VS6 END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be 0; its value is ", SQL-COD
             DISPLAY "COUNT should be 2; its value is ", tmpcnt

             if (SQLCODE  NOT =  0  OR  tmpcnt  NOT =  2) then
               MOVE 0 TO flag
             END-IF

             EXEC SQL ROLLBACK WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0519','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml087.pco *** fail *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0519','fail','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
             END-IF

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

             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
      ******************** END TEST0519 ********************

      ******************** BEGIN TEST0520 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0520 "
             DISPLAY " Underscores are legal and significant"
             DISPLAY "Reference ANSI SQL-1992 section 5.2,"
             DISPLAY " and "
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

      *Unique between columns

             COMPUTE cnt1 = -1
             COMPUTE cnt2 = -1
             COMPUTE cnt3 = -1
             COMPUTE cnt4 = -1

             DISPLAY "SELECT COUNT(*) INTO :cnt1 FROM USIG WHERE C1 =
      -    " 0;"
             DISPLAY "SELECT COUNT(*) INTO :cnt2 FROM USIG WHERE C1 =
      -    " 2;"
             DISPLAY "SELECT COUNT(*) INTO :cnt3 FROM USIG WHERE C_1 =
      -    " 0;"
             DISPLAY "SELECT COUNT(*) INTO :cnt4 FROM USIG WHERE C_1 =
      -    " 2;"

             EXEC SQL SELECT COUNT(*) INTO :cnt1 FROM USIG WHERE C1 = 0
             END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL SELECT COUNT(*) INTO :cnt2 FROM USIG WHERE C1 = 2
             END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL SELECT COUNT(*) INTO :cnt3 FROM USIG WHERE C_1 = 0
             END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL SELECT COUNT(*) INTO :cnt4 FROM USIG WHERE C_1 = 2
             END-EXEC
             MOVE SQLCODE TO SQL-COD

             DISPLAY "cnt1 cnt2 cnt3 cnt4 should be 1 0 0 1;"
             DISPLAY " they are ", cnt1 " ", cnt2 " ", cnt3 " ", cnt4

             if (cnt1  NOT =  1  OR  cnt2  NOT =  0  OR  cnt3  NOT =  0
             OR  cnt4  NOT =  1) then
               MOVE 0 TO flag
             END-IF

      *Unique between tables

             COMPUTE cnt1 = -1
             COMPUTE cnt2 = -1
             COMPUTE cnt3 = -1

             DISPLAY "SELECT COUNT(*) INTO :cnt1 FROM USIG WHERE C1 =
      -    " 4;"
             DISPLAY "SELECT COUNT(*) INTO :cnt2 FROM U_SIG WHERE C1 =
      -    " 0;"
             DISPLAY "SELECT COUNT(*) INTO :cnt3 FROM U_SIG WHERE C1 =
      -    " 4;"

             EXEC SQL SELECT COUNT(*) INTO :cnt1 FROM USIG WHERE C1 = 4
             END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL SELECT COUNT(*) INTO :cnt2 FROM U_SIG WHERE C1 = 0
             END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL SELECT COUNT(*) INTO :cnt3 FROM U_SIG WHERE C1 = 4
             END-EXEC
             MOVE SQLCODE TO SQL-COD

             DISPLAY "cnt1 cnt2 cnt3 should be 0 0 1;"
             DISPLAY " they are ", cnt1 " ", cnt2 " ", cnt3

             if (cnt1  NOT =  0  OR  cnt2  NOT =  0  OR  cnt3  NOT =  1)
             then
               MOVE 0 TO flag
             END-IF

      *Correlation name and cursor names

             COMPUTE cnt1 = -1
             COMPUTE cnt2 = -1
             COMPUTE cnt3 = -1

             DISPLAY "SELECT COUNT(*) INTO :cnt1 FROM HU.STAFF U_CN"
             DISPLAY " WHERE U_CN.GRADE IN (SELECT UCN.GRADE FROM
      -    " HU.STAFF UCN"
             DISPLAY " WHERE UCN.GRADE > 10);"
             DISPLAY "DECLARE UCRSR CURSOR FOR"
             DISPLAY " SELECT COUNT(*) FROM HU.STAFF WHERE GRADE > 10;"
             DISPLAY "DECLARE U_CRSR CURSOR FOR"
             DISPLAY " SELECT COUNT(*) FROM HU.STAFF WHERE GRADE < 10;"
             DISPLAY "OPEN UCRSR;"
             DISPLAY "FETCH UCRSR INTO :cnt2;"
             DISPLAY "CLOSE UCRSR;"
             DISPLAY "OPEN U_CRSR;"
             DISPLAY "FETCH U_CRSR INTO :cnt3;"
             DISPLAY "CLOSE U_CRSR;"

             EXEC SQL SELECT COUNT(*) INTO :cnt1 FROM HU.STAFF U_CN
               WHERE U_CN.GRADE IN (SELECT UCN.GRADE FROM HU.STAFF UCN
               WHERE UCN.GRADE > 10) END-EXEC
             MOVE SQLCODE TO SQL-COD

             EXEC SQL DECLARE UCRSR CURSOR FOR
               SELECT COUNT(*) FROM HU.STAFF WHERE GRADE > 10 END-EXEC
             EXEC SQL DECLARE U_CRSR CURSOR FOR
               SELECT COUNT(*) FROM HU.STAFF WHERE GRADE < 10 END-EXEC

             EXEC SQL OPEN UCRSR END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL FETCH UCRSR INTO :cnt2 END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL CLOSE UCRSR END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL OPEN U_CRSR END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL FETCH U_CRSR INTO :cnt3 END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL CLOSE U_CRSR END-EXEC
             MOVE SQLCODE TO SQL-COD

             DISPLAY "cnt1 cnt2 cnt3 should be 4 4 0;"
             DISPLAY " they are ", cnt1 " ", cnt2 " ", cnt3

             if (cnt1  NOT =  4  OR  cnt2  NOT =  4  OR  cnt3  NOT =  0)
             then
               MOVE 0 TO flag
             END-IF

             EXEC SQL ROLLBACK WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0520','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml087.pco *** fail *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0520','fail','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
             END-IF

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

             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
      ******************** END TEST0520 ********************

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

      *    ****  Procedures for PERFORM statements

        P50.
               EXEC SQL FETCH POIU INTO :cnt1 END-EXEC
               MOVE SQLCODE TO SQL-COD
               DISPLAY " FETCH POIU INTO :cnt1;"
               DISPLAY "cnt1 = ", cnt1 "; and SQLCODE = ", SQL-COD
               if (SQLCODE  =  0) then
                 MOVE cnt3 TO tmpcnt
               END-IF
               if (cnt3  =  4  AND  cnt1  NOT =  12) then
                 MOVE 0 TO flag
               END-IF
             ADD 1 TO cnt3
           .

quality100%

¤ Dauer der Verarbeitung: 0.16 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.