Quelle dml121.cob Sprache: Cobol

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

      * EMBEDDED COBOL (file "DML121.PCO")

      ****************************************************************
      *
      *                 COMMENT SECTION
      *
      * DATE 1994/6/7 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.
      *
      * DML121.PCO
      * WRITTEN BY:  David W. Flater
      * TRANSLATED AUTOMATICALLY FROM EMBEDDED C BY CHRIS SCHANZLE
      *
      * This routine tests FIPS features 22 and 24 and datetime
      * errata.  This is the non-dynamic version of DML122.PC.
      *
      * REFERENCES
      *   FIPS PUB 127-2 14.1 Transitional SQL
      *   ANSI SQL-1992
      *
      ****************************************************************

           EXEC SQL BEGIN DECLARE SECTION END-EXEC
       01  SQLCODE PIC S9(9) COMP.
       01  SQLSTATE PIC  X(5).
       01  uid PIC  X(18).
       01  uidx PIC  X(18).
       01  int1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  flt1 PIC S9(4)V9(4) DISPLAY SIGN LEADING SEPARATE.
       01  alice PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  betty PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  don PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  name PIC  X(20).
             EXEC SQL END DECLARE SECTION END-EXEC
       01  norm1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  norm2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  ALPNUM-TABLE VALUE IS
               "01234ABCDEFGH56789IJKLMNOPQRSTUVWXYZ".
           05  ALPNUM PIC X OCCURS 36 TIMES.
       01  NORMSQ.
           05  NORMSQX PIC X OCCURS 5 TIMES.
       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
             EXEC SQL ROLLBACK WORK 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, dml121.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 TEST0649 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0649 "
             DISPLAY " Feature 22, Explicit defaults (static)"
             DISPLAY "References:"
             DISPLAY " FIPS PUB 127-2 14.1 Transitional SQL feature
      -    " 22"
             DISPLAY " 13.8 LR.2.d -- DEFAULT VALUES in an
      -    " statement>"
             DISPLAY " 7.1 LR.2.a -- DEFAULT in a
      -    " constructor>"
             DISPLAY " 11.5 LR.2.a -- various things in a
      -    " option>"
             DISPLAY " 13.9 LR.2.c -- DEFAULT in update statements"
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             COMPUTE SQLCODE = -1
             MOVE "xxxxx" TO SQLSTATE

      *This feature was tested for datetimes in TEST0631

      *Feature 22 in 127-2 seems to imply that SYSTEM_USER and
      *SESSION_USER would be legal in a <default option>, but
      *this is obviously not the intention since Intermediate
      *feature 32 is where they are made legal in a <general
      *value specification>.

             DISPLAY "CREATE TABLE SSSLOG ("
             DISPLAY " ENTERED_BY CHAR (128) DEFAULT USER,"
             DISPLAY " SEVERITY INT DEFAULT 1,"
             DISPLAY " PROBLEM CHAR (40) DEFAULT NULL);"
             EXEC SQL CREATE TABLE SSSLOG (
               ENTERED_BY CHAR (128) DEFAULT USER,
               SEVERITY INT DEFAULT 1,
               PROBLEM CHAR (40) DEFAULT NULL) END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "COMMIT WORK;"
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO SSSLOG DEFAULT VALUES;"
      *       EXEC SQL INSERT INTO SSSLOG DEFAULT VALUES END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO SSSLOG VALUES"
             DISPLAY " (DEFAULT, DEFAULT, DEFAULT);"
             EXEC SQL INSERT INTO SSSLOG VALUES
               (DEFAULT, DEFAULT, DEFAULT) END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO SSSLOG VALUES"
             DISPLAY " (DEFAULT, 3, 'Cross-linked inode');"
             EXEC SQL INSERT INTO SSSLOG VALUES
               (DEFAULT, 3, 'Cross-linked inode') END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO SSSLOG VALUES"
             DISPLAY " ('system', DEFAULT, 'Freed a free frag');"
             EXEC SQL INSERT INTO SSSLOG VALUES
               ('system', DEFAULT, 'Freed a free frag') END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO SSSLOG VALUES"
             DISPLAY " ('nobody', 6, DEFAULT);"
             EXEC SQL INSERT INTO SSSLOG VALUES
               ('nobody', 6, DEFAULT) END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *Cross-linked inodes are _nasty_

             DISPLAY "UPDATE SSSLOG SET SEVERITY = DEFAULT"
             DISPLAY " WHERE PROBLEM LIKE '%inode%';"
             EXEC SQL UPDATE SSSLOG SET SEVERITY = DEFAULT
               WHERE PROBLEM LIKE '%inode%' END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             COMPUTE int1 = -1
             DISPLAY "SELECT COUNT(*) INTO :int1 FROM SSSLOG WHERE"
             DISPLAY " ENTERED_BY = 'FLATER' AND SEVERITY = 1"
             DISPLAY " AND PROBLEM IS NULL;"
             EXEC SQL SELECT COUNT(*) INTO :int1 FROM SSSLOG WHERE
               ENTERED_BY = 'FLATER' AND SEVERITY = 1
               AND PROBLEM IS NULL END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "int1 should be 2; its value is ", int1
             if (int1  NOT =  2) then
               MOVE 0 TO flag
             END-IF

             COMPUTE int1 = -1
             DISPLAY "SELECT COUNT(*) INTO :int1 FROM SSSLOG WHERE"
             DISPLAY " ENTERED_BY = 'FLATER' AND SEVERITY = 1"
             DISPLAY " AND PROBLEM = 'Cross-linked inode';"
             EXEC SQL SELECT COUNT(*) INTO :int1 FROM SSSLOG WHERE
               ENTERED_BY = 'FLATER' AND SEVERITY = 1
               AND PROBLEM = 'Cross-linked inode' END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "int1 should be 1; its value is ", int1
             if (int1  NOT =  1) then
               MOVE 0 TO flag
             END-IF

             COMPUTE int1 = -1
             DISPLAY "SELECT COUNT(*) INTO :int1 FROM SSSLOG WHERE"
             DISPLAY " ENTERED_BY = 'system' AND SEVERITY = 1"
             DISPLAY " AND PROBLEM = 'Freed a free frag';"
             EXEC SQL SELECT COUNT(*) INTO :int1 FROM SSSLOG WHERE
               ENTERED_BY = 'system' AND SEVERITY = 1
               AND PROBLEM = 'Freed a free frag' END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "int1 should be 1; its value is ", int1
             if (int1  NOT =  1) then
               MOVE 0 TO flag
             END-IF

             COMPUTE int1 = -1
             DISPLAY "SELECT COUNT(*) INTO :int1 FROM SSSLOG WHERE"
             DISPLAY " ENTERED_BY = 'nobody' AND SEVERITY = 6"
             DISPLAY " AND PROBLEM IS NULL;"
             EXEC SQL SELECT COUNT(*) INTO :int1 FROM SSSLOG WHERE
               ENTERED_BY = 'nobody' AND SEVERITY = 6
               AND PROBLEM IS NULL END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "int1 should be 1; its value is ", int1
             if (int1  NOT =  1) then
               MOVE 0 TO flag
             END-IF

             DISPLAY "COMMIT WORK;"
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "DROP TABLE SSSLOG CASCADE;"
             EXEC SQL DROP TABLE SSSLOG CASCADE END-EXEC
             MOVE SQLCODE TO SQL-COD

           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "COMMIT WORK;"
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

           PERFORM CHCKOK
             DISPLAY  " "

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0649','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml121.pco *** fail *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0649','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 TEST0649 ********************
      ******************** BEGIN TEST0651 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0651 "
             DISPLAY " Feature 24, Keyword relaxations (static)"
             DISPLAY "References:"
             DISPLAY " FIPS PUB 127-2 14.1 Transitional SQL feature
      -    " 24"
             DISPLAY " 6.3 LR.2.b -- AS "
             DISPLAY " 11.36 LR.2.a -- TABLE with GRANT"
             DISPLAY " 13.3 LR.2.b -- FETCH FROM "
             DISPLAY " 14.3 LR.2.a -- COMMIT;"
             DISPLAY " 14.4 LR.2.a -- ROLLBACK;"
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             COMPUTE SQLCODE = -1
             MOVE "xxxxx" TO SQLSTATE

      *Designers are verbose!

             DISPLAY "CREATE VIEW VERBOSE_PEOPLE AS"
             DISPLAY " SELECT EMPNAME FROM HU.STAFF AS EMPLOYEES_OF_HU"
             DISPLAY " WHERE EMPLOYEES_OF_HU.EMPNUM IN"
             DISPLAY " (SELECT EMPNUM FROM HU.PROJ AS HUPROJ, HU.WORKS"
             DISPLAY " WHERE PTYPE = 'Design'"
             DISPLAY " AND HUPROJ.PNUM = HU.WORKS.PNUM);"
             EXEC SQL CREATE VIEW VERBOSE_PEOPLE AS
               SELECT EMPNAME FROM HU.STAFF AS EMPLOYEES_OF_HU
               WHERE EMPLOYEES_OF_HU.EMPNUM IN
               (SELECT EMPNUM FROM HU.PROJ AS HUPROJ, HU.WORKS
               WHERE PTYPE = 'Design'
               AND HUPROJ.PNUM = HU.WORKS.PNUM) END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "COMMIT;"
             EXEC SQL COMMIT END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *Saying 'GRANT SELECT ON TABLE VERBOSE_PEOPLE' when
      *VERBOSE_PEOPLE is a view is dubious practice, but it
      *serves to emphasize the fact that the optional keyword
      *has no semantics whatsoever and should be totally
      *ignored.

             DISPLAY "GRANT SELECT ON TABLE VERBOSE_PEOPLE TO PUBLIC;"
             EXEC SQL GRANT SELECT ON TABLE VERBOSE_PEOPLE TO PUBLIC
             END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "COMMIT;"
             EXEC SQL COMMIT END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             MOVE 0 TO alice
             MOVE 0 TO betty
             MOVE 0 TO don

             DISPLAY "DECLARE BEACH_PARTY CURSOR FOR"
             DISPLAY " SELECT EMPNAME AS NAAM FROM VERBOSE_PEOPLE;"
             EXEC SQL DECLARE BEACH_PARTY CURSOR FOR
               SELECT EMPNAME AS NAAM FROM VERBOSE_PEOPLE END-EXEC

             DISPLAY  " "

             DISPLAY "OPEN BEACH_PARTY;"
             EXEC SQL OPEN BEACH_PARTY END-EXEC
             MOVE SQLCODE TO SQL-COD

           PERFORM CHCKOK
             DISPLAY  " "

             MOVE "xxxxxxxxxxxxxxxxxxxx" TO name
             DISPLAY "We ought to get Alice, Betty, and Don."

           .
        P199.
             DISPLAY "FETCH FROM BEACH_PARTY INTO :name;"
             EXEC SQL FETCH BEACH_PARTY INTO :name END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "name is '", name "'"
             if (SQLCODE  <  0) then
           PERFORM CHCKOK
               DISPLAY  " "
               GO TO P198
             END-IF
             if (SQLCODE  >  0) then
               GO TO P197
             END-IF
           PERFORM CHCKOK
             DISPLAY  " "
             if (name   =   "Alice") then
               COMPUTE alice = alice + 1
               GO TO P199
             END-IF
             if (name   =   "Betty") then
               COMPUTE betty = betty + 1
               GO TO P199
             END-IF
             if (name   =   "Don") then
               COMPUTE don = don + 1
               GO TO P199
             END-IF
             MOVE 0 TO flag
             GO TO P199

           .
        P197.
             DISPLAY "SQLCODE should be 100; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 02000; its value is ", SQLSTATE
           PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE  NOT =  100  OR  NORMSQ  NOT  =   "02000") then
               MOVE 0 TO flag
             END-IF
             if (NORMSQ   =   "02000"  AND  NORMSQ  NOT  =   SQLSTATE)
             then
               DISPLAY "Valid implementation-defined SQLSTATE accepted."
             END-IF
             DISPLAY  " "

           .
        P198.
             if (alice  NOT =  1  OR  betty  NOT =  1  OR  don  NOT =
             1) then
               MOVE 0 TO flag
             END-IF

             DISPLAY "CLOSE BEACH_PARTY;"
             EXEC SQL CLOSE BEACH_PARTY END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "ROLLBACK;"
             EXEC SQL ROLLBACK END-EXEC
             MOVE SQLCODE TO SQL-COD

           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "DROP VIEW VERBOSE_PEOPLE CASCADE;"
             EXEC SQL DROP VIEW VERBOSE_PEOPLE CASCADE END-EXEC
             MOVE SQLCODE TO SQL-COD

           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "COMMIT WORK;"
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

           PERFORM CHCKOK
             DISPLAY  " "

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0651','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml121.pco *** fail *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0651','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 TEST0651 ********************
      ******************** BEGIN TEST0661 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0661 "
             DISPLAY " Errata: datetime casting (static)"
             DISPLAY "References:"
             DISPLAY " TC #2 5.3 6.10"
             DISPLAY " X3H2-94-015/DBL SOU-031, SQL-92 Errata:"
             DISPLAY " Casting Between Datetimes and Character
      -    " Strings"
             DISPLAY " F# 5 -- DATETIME data types"
             DISPLAY " 6.10 -- "
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             COMPUTE SQLCODE = -1
             MOVE "xxxxx" TO SQLSTATE

             DISPLAY "CREATE TABLE LOTSA_DATETIMES ("
             DISPLAY " C1 DATE, C2 TIME, C3 TIMESTAMP,"
             DISPLAY " C4 INTERVAL YEAR, C5 INTERVAL MONTH, C6 INTERVAL
      -    " DAY,"
             DISPLAY " C7 INTERVAL HOUR, C8 INTERVAL MINUTE, C9
      -    " INTERVAL SECOND,"
             DISPLAY " C10 INTERVAL YEAR TO MONTH,"
             DISPLAY " C11 INTERVAL DAY TO HOUR,"
             DISPLAY " C12 INTERVAL DAY TO MINUTE,"
             DISPLAY " C13 INTERVAL DAY TO SECOND,"
             DISPLAY " C14 INTERVAL HOUR TO MINUTE,"
             DISPLAY " C15 INTERVAL HOUR TO SECOND,"
             DISPLAY " C16 INTERVAL MINUTE TO SECOND);"
             EXEC SQL CREATE TABLE LOTSA_DATETIMES (
               C1 DATE, C2 TIME, C3 TIMESTAMP,
               C4 DATE, C5 DATE, C6 DATE,
               C7 INTERVAL HOUR, C8 INTERVAL MINUTE, C9 INTERVAL SECOND,
               C10 INTERVAL YEAR TO MONTH,
               C11 INTERVAL DAY TO HOUR,
               C12 INTERVAL DAY TO MINUTE,
               C13 INTERVAL DAY TO SECOND,
               C14 INTERVAL HOUR TO MINUTE,
               C15 INTERVAL HOUR TO SECOND,
               C16 INTERVAL MINUTE TO SECOND) END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "COMMIT WORK;"
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO LOTSA_DATETIMES VALUES ("
             DISPLAY " CAST ('1976-06-21' AS DATE),"
             DISPLAY " CAST ('13:24:00' AS TIME),"
             DISPLAY " CAST ('1927-11-30 07:10:00' AS TIMESTAMP),"
             DISPLAY " CAST ('-1' AS INTERVAL YEAR),"
             DISPLAY " CAST ('+2' AS INTERVAL MONTH),"
             DISPLAY " CAST ('-3' AS INTERVAL DAY),"
             DISPLAY " CAST ('4' AS INTERVAL HOUR),"
             DISPLAY " CAST ('-5' AS INTERVAL MINUTE),"
             DISPLAY " CAST ('6.333333' AS INTERVAL SECOND),"
             DISPLAY " CAST ('-5-11' AS INTERVAL YEAR TO MONTH),"
             DISPLAY " CAST ('2 15' AS INTERVAL DAY TO HOUR),"
             DISPLAY " CAST ('-3 4:05' AS INTERVAL DAY TO MINUTE),"
             DISPLAY " CAST ('+6 17:08:09' AS INTERVAL DAY TO
      -    " SECOND),"
             DISPLAY " CAST ('-10:45' AS INTERVAL HOUR TO MINUTE),"
             DISPLAY " CAST ('11:23:45.75' AS INTERVAL HOUR TO
      -    " SECOND),"
             DISPLAY " CAST ('-20:00' AS INTERVAL MINUTE TO
      -    " SECOND));"
             EXEC SQL INSERT INTO LOTSA_DATETIMES VALUES (
               CAST ('1976-06-21' AS DATE),
               CAST ('13:24:00' AS TIME),
               CAST ('1927-11-30 07:10:00' AS TIMESTAMP),
               CAST ('-1' AS INTERVAL YEAR),
               CAST ('+2' AS INTERVAL MONTH),
               CAST ('-3' AS INTERVAL DAY),
               CAST ('4' AS INTERVAL HOUR),
               CAST ('-5' AS INTERVAL MINUTE),
               CAST ('6.333333' AS INTERVAL SECOND),
               CAST ('-5-11' AS INTERVAL YEAR TO MONTH),
               CAST ('2 15' AS INTERVAL DAY TO HOUR),
               CAST ('-3 4:05' AS INTERVAL DAY TO MINUTE),
               CAST ('+6 17:08:09' AS INTERVAL DAY TO SECOND),
               CAST ('-10:45' AS INTERVAL HOUR TO MINUTE),
               CAST ('11:23:45.75' AS INTERVAL HOUR TO SECOND),
               CAST ('-20:00' AS INTERVAL MINUTE TO SECOND)) END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             COMPUTE int1 = -1
             DISPLAY "SELECT COUNT(*) INTO :int1 FROM LOTSA_DATETIMES"
             DISPLAY " WHERE C1 = DATE '1976-06-21' AND"
             DISPLAY " C2 = TIME '13:24:00' AND"
             DISPLAY " C3 = TIMESTAMP '1927-11-30 07:10:00.000000' AND"
             DISPLAY " C4 = INTERVAL -'1' YEAR AND"
             DISPLAY " C5 = INTERVAL -'-2' MONTH AND"
             DISPLAY " C6 = INTERVAL '-3' DAY AND"
             DISPLAY " C7 = INTERVAL '4' HOUR AND"
             DISPLAY " C8 = INTERVAL -'5' MINUTE AND"
             DISPLAY " C9 = INTERVAL '6.333333' SECOND AND"
             DISPLAY " C10 = INTERVAL -'5-11' YEAR TO MONTH AND"
             DISPLAY " C11 = INTERVAL +'2 15' DAY TO HOUR AND"
             DISPLAY " C12 = INTERVAL '-3 4:05' DAY TO MINUTE AND"
             DISPLAY " C13 = INTERVAL '+6 17:08:09.000000' DAY TO
      -    " SECOND AND"
             DISPLAY " C14 = INTERVAL '-10:45' HOUR TO MINUTE AND"
             DISPLAY " C15 = INTERVAL '11:23:45.750000' HOUR TO
      -    " SECOND;"
             EXEC SQL SELECT COUNT(*) INTO :int1 FROM LOTSA_DATETIMES
               WHERE C1 = DATE '1976-06-21' AND
               C2 = TIME '13:24:00' AND
               C3 = TIMESTAMP '1927-11-30 07:10:00.000000' AND
               C4 = INTERVAL -'1' YEAR AND
               C5 = INTERVAL -'-2' MONTH AND
               C6 = INTERVAL '-3' DAY AND
               C7 = INTERVAL '4' HOUR AND
               C8 = INTERVAL -'5' MINUTE AND
               C9 = INTERVAL '6.333333' SECOND AND
               C10 = INTERVAL -'5-11' YEAR TO MONTH AND
               C11 = INTERVAL +'2 15' DAY TO HOUR AND
               C12 = INTERVAL '-3 4:05' DAY TO MINUTE AND
               C13 = INTERVAL '+6 17:08:09.000000' DAY TO SECOND AND
               C14 = INTERVAL '-10:45' HOUR TO MINUTE AND
               C15 = INTERVAL '11:23:45.750000' HOUR TO SECOND END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "int1 should be 1; its value is ", int1
      *TEd hook #1
             if (int1  NOT =  1) then
               MOVE 0 TO flag
             END-IF

             DISPLAY "COMMIT WORK;"
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "DROP TABLE LOTSA_DATETIMES CASCADE;"
             EXEC SQL DROP TABLE LOTSA_DATETIMES CASCADE END-EXEC
             MOVE SQLCODE TO SQL-COD

           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "COMMIT WORK;"
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

           PERFORM CHCKOK
             DISPLAY  " "

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0661','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml121.pco *** fail *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0661','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 TEST0661 ********************
      ******************** BEGIN TEST0663 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0663 "
             DISPLAY " Errata: datetime SQLSTATEs (static)"
             DISPLAY "References:"
             DISPLAY " TC #2 6.1 6.10 22.1"
             DISPLAY " X3H2-93-270/DBL YOK-165, Invalid datetime
      -    " format"
             DISPLAY " F# 5 -- DATETIME data types"
             DISPLAY " 6.10 -- "
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             COMPUTE SQLCODE = -1
             MOVE "xxxxx" TO SQLSTATE

             DISPLAY "CREATE TABLE WOODCHUCK ("
             DISPLAY " OBSERVATION DATE,"
             DISPLAY " WOOD_AGE INTERVAL YEAR TO MONTH);"
             EXEC SQL CREATE TABLE WOODCHUCK (
               OBSERVATION DATE,
               WOOD_AGE INTERVAL YEAR TO MONTH) END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "COMMIT WORK;"
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *Invalid datetime format 22007

             DISPLAY "INSERT INTO WOODCHUCK VALUES ("
             DISPLAY " CAST ('1994-02-30' AS DATE), NULL);"
             EXEC SQL INSERT INTO WOODCHUCK VALUES (
               CAST ('1994-02-30' AS DATE), NULL) 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 "SQLSTATE should be 22007; its value is ", SQLSTATE
             if (SQLSTATE  NOT  =   "22007") then
               MOVE 0 TO flag
             END-IF

      *Invalid interval format 22006

             DISPLAY "INSERT INTO WOODCHUCK VALUES ("
             DISPLAY " NULL, CAST ('1-12' AS INTERVAL YEAR TO MONTH));"
             EXEC SQL INSERT INTO WOODCHUCK VALUES (
               NULL, CAST ('1-12' AS INTERVAL YEAR TO MONTH)) 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 "SQLSTATE should be 22006; its value is ", SQLSTATE
             if (SQLSTATE  NOT  =   "22006") then
               MOVE 0 TO flag
             END-IF

             DISPLAY "COMMIT WORK;"
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "DROP TABLE WOODCHUCK CASCADE;"
             EXEC SQL DROP TABLE WOODCHUCK CASCADE END-EXEC
             MOVE SQLCODE TO SQL-COD

           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "COMMIT WORK;"
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

           PERFORM CHCKOK
             DISPLAY  " "

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0663','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml121.pco *** fail *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0663','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 TEST0663 ********************
      **** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0
           STOP RUN.

      *    ****  Procedures for PERFORM statements

      *Test SQLCODE and SQLSTATE for normal completion.
       CHCKOK.
             DISPLAY "SQLCODE should be 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 00000; its value is ", SQLSTATE
             PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE NOT =  0  OR   NORMSQ NOT = "00000") then
               MOVE 0 TO flag
             END-IF
             if (NORMSQ = "00000"  AND  NORMSQ NOT = SQLSTATE)
             then
               DISPLAY "Valid implementation-defined SQLSTATE accepted."
             END-IF
             .

       NOSUBCLASS.

      *This routine replaces valid implementation-defined
      *subclasses with 000.  This replacement equates valid
      *implementation-defined subclasses with the 000 value
      *expected by the test case; otherwise the test will fail.
      *After calling NOSUBCLASS, NORMSQ will be tested
      *                          SQLSTATE will be printed.

           MOVE SQLSTATE TO NORMSQ

           MOVE 3 TO norm1
      *subclass begins in position 3 of char array NORMSQ
      *valid subclass begins with 5-9, I-Z, end of ALPNUM table
           PERFORM VARYING norm2 FROM 14 BY 1 UNTIL norm2 > 36
           if (NORMSQX(norm1)  =  ALPNUM(norm2)) then
             MOVE "0" TO NORMSQX(norm1)
           END-IF
           END-PERFORM

      *Quit if NORMSQ is unchanged.  Subclass is not impl.-def.
      *Changed NORMSQ means implementation-defined subclass,
      *so proceed to zero it out, if valid (0-9,A-Z)
           if (NORMSQ   =   SQLSTATE) then
             GO TO EXIT-NOSUBCLASS
           END-IF

           MOVE 4 TO norm1
      *examining position 4 of char array NORMSQ
      *valid characters are 0-9, A-Z
           PERFORM VARYING norm2 FROM 1 BY 1 UNTIL norm2 > 36
           if (NORMSQX(norm1)  =  ALPNUM(norm2)) then
             MOVE "0" TO NORMSQX(norm1)
           END-IF
           END-PERFORM

           MOVE 5 TO norm1
      *valid characters are 0-9, A-Z
      *examining position 5 of char array NORMSQ
           PERFORM VARYING norm2 FROM 1 BY 1 UNTIL norm2 > 36
           if (NORMSQX(norm1)  =  ALPNUM(norm2)) then
             MOVE "0" TO NORMSQX(norm1)
           END-IF
           END-PERFORM

      *implementation-defined subclasses are allowed for warnings
      *(class = 01).  These equate to successful completion
      *SQLSTATE values of 00000.
      *Reference SQL-92 4.28 SQL-transactions, paragraph 2

           if (NORMSQX(1)  =  "0"  AND  NORMSQX(2)  =  "1") then
             MOVE "0" TO NORMSQX(2)
           END-IF
           .

       EXIT-NOSUBCLASS.
           EXIT.

quality98%

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