Quelle dml090.cob Sprache: Cobol

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

      * EMBEDDED COBOL (file "DML090.PCO")

      ****************************************************************
      *
      *                 COMMENT SECTION
      *
      * DATE 1992/07/13 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.
      *
      * DML090.PCO
      * WRITTEN BY: Joan Sullivan
      *
      *   THIS ROUTINE TESTS ADDITIONAL SQL-89 FEATURES
      *
      * REFERENCES
      *   ANSI SQL-1992
      *     22.1  SQLSTATE
      *
      ****************************************************************

           EXEC SQL BEGIN DECLARE SECTION END-EXEC
       01  uid PIC  X(18).
       01  uidx PIC  X(18).
       01  LONG1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  ii PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  jj PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  kk PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  CITY1 PIC  X(15).
       01  PTYPE1 PIC  X(6).
             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 "HU " 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

           DISPLAY
              "SQL Test Suite, V6.0, Embedded COBOL, dml090.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 TEST0512 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0512 "
             DISPLAY " for IN predicate"
             DISPLAY "Reference ANSI SQL-1992 section 8.4 "
             DISPLAY "Format for "
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             DISPLAY "SELECT MIN(PNAME) INTO :PTYPE1"
             DISPLAY " FROM PROJ, WORKS, STAFF "
             DISPLAY " WHERE PROJ.PNUM = WORKS.PNUM"
             DISPLAY " AND WORKS.EMPNUM = STAFF.EMPNUM"
             DISPLAY " AND BUDGET - GRADE * HOURS * 100 IN"
             DISPLAY " (:kk, -1000, :jj) "

             MOVE 4000 TO jj
             COMPUTE kk = -4400
             MOVE "xx" TO PTYPE1
             EXEC SQL SELECT MIN(PNAME) INTO :PTYPE1
               FROM PROJ, WORKS, STAFF
               WHERE PROJ.PNUM = WORKS.PNUM
               AND WORKS.EMPNUM = STAFF.EMPNUM
               AND BUDGET - GRADE * HOURS * 100 IN
               (:kk, -1000, :jj) END-EXEC
             MOVE SQLCODE TO SQL-COD

             DISPLAY "PTYPE1 should be CALM; its value is ", PTYPE1

             if (PTYPE1  NOT  =   "CALM ") then
               MOVE 0 TO flag
             END-IF

             COMPUTE LONG1 = -1
             MOVE "Kensington" TO CITY1
             MOVE 2 TO ii
             MOVE 20000 TO jj
             MOVE 10000 TO kk

             DISPLAY "DECLARE ZZZ CURSOR FOR"
             DISPLAY " SELECT CITY, COUNT(*) FROM PROJ"
             DISPLAY " GROUP BY CITY"
             DISPLAY " HAVING (MAX(BUDGET) - MIN(BUDGET)) / :ii"
             DISPLAY " IN (:ii, :jj, :kk) "
             DISPLAY " ORDER BY CITY DESC;"
             DISPLAY "OPEN ZZZ;"
             DISPLAY "FETCH ZZZ INTO :CITY1, :LONG1;"

             EXEC SQL DECLARE ZZZ CURSOR FOR
               SELECT CITY, COUNT(*) FROM PROJ
               GROUP BY CITY
               HAVING (MAX(BUDGET) - MIN(BUDGET)) / :ii
               IN (:ii, :jj, :kk)
               ORDER BY CITY DESC END-EXEC

             EXEC SQL OPEN ZZZ END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL FETCH ZZZ INTO :CITY1, :LONG1 END-EXEC
             MOVE SQLCODE TO SQL-COD

             DISPLAY " CITY1 should be Vienna; LONG1 should be 2 "
             DISPLAY " CITY1 is ", CITY1 " ; LONG1 is ", LONG1

             if (CITY1  NOT  =   "Vienna "  OR  LONG1  NOT =  2)
             then
               MOVE 0 TO flag
             END-IF

             DISPLAY "FETCH ZZZ INTO :CITY1, :LONG1;"

             EXEC SQL FETCH ZZZ INTO :CITY1, :LONG1 END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY " CITY1 should be Deale; LONG1 should be 3 "
             DISPLAY " CITY1 is ", CITY1 "; LONG1 is ", LONG1

             if (CITY1  NOT  =   "Deale "  OR  LONG1  NOT =  3)
             then
               MOVE 0 TO flag
             END-IF

             DISPLAY "FETCH ZZZ INTO :CITY1, :LONG1;"

             EXEC SQL FETCH ZZZ INTO :CITY1, :LONG1 END-EXEC
             MOVE SQLCODE TO SQL-COD

             DISPLAY " SQLCODE should be 100; its value is ", SQL-COD
             if (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('0512','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml090.pco *** fail *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0512','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 TEST0512 ********************

      ******************** BEGIN TEST0513 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0513 "
             DISPLAY "NUMERIC(4) implies CHECK BETWEEN -9999 AND 9999"
             DISPLAY "Reference ANSI SQL-1992 section 6.1, SR 17"
             DISPLAY " compare to 6.1 SR18 for DECIMAL"
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             DISPLAY "DELETE FROM TEMP_OBSERV;"
             DISPLAY "INSERT INTO TEMP_OBSERV (YEAR_OBSERV)"
             DISPLAY " VALUES (9999);"

             EXEC SQL DELETE FROM TEMP_OBSERV END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL INSERT INTO TEMP_OBSERV (YEAR_OBSERV)
               VALUES (9999) END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY " SQLCODE should be 0; its value is ", SQL-COD
             if (SQLCODE  NOT =  0) then
               MOVE 0 TO flag
             END-IF

             DISPLAY "INSERT INTO TEMP_OBSERV (YEAR_OBSERV)"
             DISPLAY " VALUES (10000);"
             EXEC SQL INSERT INTO TEMP_OBSERV (YEAR_OBSERV)
               VALUES (10000) END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY " SQLCODE should be < 0; its value is ", SQL-COD
             if (SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF

             DISPLAY "UPDATE TEMP_OBSERV"
             DISPLAY " SET YEAR_OBSERV = -10000"
             DISPLAY " WHERE YEAR_OBSERV = 9999;"
             EXEC SQL UPDATE TEMP_OBSERV
               SET YEAR_OBSERV = -10000
               WHERE YEAR_OBSERV = 9999 END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY " SQLCODE should be < 0; its value is ", SQL-COD
             if (SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF

             DISPLAY "INSERT "
             DISPLAY " INTO TEMP_OBSERV (YEAR_OBSERV, MAX_TEMP)"
             DISPLAY " VALUES (-9999, 123.4517);"
             EXEC SQL INSERT INTO TEMP_OBSERV (YEAR_OBSERV, MAX_TEMP)
               VALUES (-9999, 123.4517) END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY " SQLCODE should be 0; its value is ", SQL-COD
             if (SQLCODE  NOT =  0) then
               MOVE 0 TO flag
             END-IF

             COMPUTE LONG1 = -1
             DISPLAY "SELECT COUNT(*) INTO :LONG1 FROM "
             DISPLAY " TEMP_OBSERV WHERE MAX_TEMP = 123.45"
             DISPLAY " AND MAX_TEMP NOT BETWEEN 123.4516 AND
      -    " 123.4518;"
             EXEC SQL SELECT COUNT(*) INTO :LONG1 FROM TEMP_OBSERV
               WHERE MAX_TEMP = 123.45
               AND MAX_TEMP NOT BETWEEN 123.4516 AND 123.4518 END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "LONG1 should be 1; its value is ", LONG1
             if (LONG1  NOT =  1) then
               MOVE 0 TO flag
             END-IF

             EXEC SQL INSERT INTO TEMP_OBSERV (YEAR_OBSERV, MAX_TEMP)
               VALUES (-9999, 1234.51) END-EXEC
             MOVE SQLCODE TO SQL-COD

             DISPLAY "INSERT INTO TEMP_OBSERV "
             DISPLAY " (YEAR_OBSERV, MAX_TEMP) VALUES (-9999,
      -    " 1234.51);"
             DISPLAY " SQLCODE should be < 0; its value is ", SQL-COD
             if (SQLCODE  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('0513','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml090.pco *** fail *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0513','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 TEST0513 ********************

      ******************** BEGIN TEST0523 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0523 "
             DISPLAY " for BETWEEN predicate"
             DISPLAY "Reference ANSI SQL-1992 section 8.3 "
             DISPLAY "Format for "
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             MOVE 1000 TO ii
             MOVE 50000 TO jj
             MOVE 24 TO kk
             COMPUTE LONG1 = -1

             DISPLAY "SELECT COUNT(*) INTO :LONG1 FROM PROJ"
             DISPLAY " WHERE :kk * :ii BETWEEN BUDGET - 5000 AND :jj /
      -    " 1.7;"
             DISPLAY "where variables are: ii = ", ii "; jj = ", jj ";
      -    " kk = ", kk
             EXEC SQL SELECT COUNT(*) INTO :LONG1
               FROM PROJ
               WHERE :kk * :ii BETWEEN BUDGET - 5000 AND :jj / 1.7
             END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "LONG1 should be 3; its value is ", LONG1
             if (LONG1  NOT =  3) then
               MOVE 0 TO flag
             END-IF

             MOVE "Tampa" TO CITY1
             MOVE "NOTMOI" TO PTYPE1
             EXEC SQL SELECT PNAME INTO :PTYPE1
               FROM PROJ
               WHERE :CITY1 NOT BETWEEN CITY AND 'Vienna'
               AND PNUM > 'P2' END-EXEC
             MOVE SQLCODE TO SQL-COD

             DISPLAY "SELECT PNAME INTO :PTYPE1"
             DISPLAY " FROM PROJ"
             DISPLAY " WHERE :CITY1 NOT BETWEEN CITY AND 'Vienna'"
             DISPLAY " AND PNUM > 'P2';"
             DISPLAY " PTYPE1 should be 'IRM'; its value is ", PTYPE1
             if (PTYPE1  NOT  =   "IRM ") then
               MOVE 0 TO flag
             END-IF

             MOVE "Kensington" TO CITY1
             MOVE 50000 TO jj
             COMPUTE LONG1 = -1

             DISPLAY "DECLARE KKK CURSOR FOR"
             DISPLAY " SELECT CITY, COUNT(*) FROM PROJ"
             DISPLAY " GROUP BY CITY"
             DISPLAY " HAVING :jj + 2 BETWEEN 33000 AND SUM(BUDGET) -
      -    " 20;"
             DISPLAY "OPEN KKK;"
             DISPLAY "FETCH KKK INTO :CITY1, :LONG1;"

             EXEC SQL DECLARE KKK CURSOR FOR
               SELECT CITY, COUNT(*) FROM PROJ
               GROUP BY CITY
               HAVING :jj + 2 BETWEEN 33000 AND SUM(BUDGET) - 20
             END-EXEC
             EXEC SQL OPEN KKK END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL FETCH KKK INTO :CITY1, :LONG1 END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "LONG1 should be 3; its value is ", LONG1
             DISPLAY "CITY1 should be 'Deale'; its value is ", CITY1
             if (CITY1  NOT  =   "Deale "  OR  LONG1  NOT =  3)
             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('0523','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml090.pco *** fail *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0523','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 TEST0523 ********************

      ******************** BEGIN TEST0564 *******************
             MOVE 1 TO flag
             COMPUTE LONG1 =  -1

             DISPLAY " TEST0564 "
             DISPLAY " Reference ANSI SQL 1992 subclause 7.8 "
             DISPLAY " , SR 1 "
             DISPLAY " A directly contained in the"
             DISPLAY " of a may be"
             DISPLAY " an outer reference."
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             DISPLAY "DECLARE P_JONES CURSOR FOR"
             DISPLAY " SELECT EMPNUM, GRADE*1000 "
             DISPLAY " FROM HU.STAFF WHERE GRADE * 1000 > ANY"
             DISPLAY " (SELECT SUM(BUDGET) FROM HU.PROJ"
             DISPLAY " GROUP BY CITY, PTYPE "
             DISPLAY " HAVING HU.PROJ.CITY =
      -    " HU.STAFF.CITY);"
             DISPLAY "OPEN P_JONES;"
             DISPLAY "FETCH P_JONES INTO :PTYPE1, :LONG1;"

             MOVE "xx" TO PTYPE1
             EXEC SQL DECLARE P_JONES CURSOR FOR
               SELECT EMPNUM, GRADE*1000
               FROM HU.STAFF WHERE GRADE * 1000 > ANY
               (SELECT SUM(BUDGET) FROM HU.PROJ
               GROUP BY CITY, PTYPE
               HAVING HU.PROJ.CITY = HU.STAFF.CITY) END-EXEC
             EXEC SQL OPEN P_JONES END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL FETCH P_JONES INTO :PTYPE1, :LONG1 END-EXEC
             MOVE SQLCODE TO SQL-COD

             DISPLAY "PTYPE1 should be E3; its value is ", PTYPE1
             DISPLAY "LONG1 should be 13000; its value is ", LONG1
             if (PTYPE1  NOT  =   "E3 "  OR  LONG1  NOT =  13000)
             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('0564','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml090.pco *** fail *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0564','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 TEST0564 ********************

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

      *    ****  Procedures for PERFORM statements

quality100%

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