Impressum dml058.cob Sprache: Cobol

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

      * EMBEDDED COBOL (file "DML058.PCO")

      ****************************************************************
      *
      *                 COMMENT SECTION
      *
      * DATE 1988/04/28 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.
      *
      * DML058.PCO
      * WRITTEN BY: SUN DAJUN
      * TRANSLATED AUTOMATICALLY FROM EMBEDDED C BY CHRIS SCHANZLE
      *
      *   THIS ROUTINE TESTS THE COMMIT,ROLLBACK AND UPDATE STATEMENT
      * IN THE LANGUAGE OF SQL.  THE FORMAT:
      *               COMMIT WORK
      *
      *               ROLLBACK WORK
      *
      *               UPDATE <table name>
      *               SET  <set clause:searched>({,<set clause>}...)
      *               (WHERE <search condition>)
      *
      * REFERENCES
      *       AMERICAN NATIONAL STANDARD database language - SQL
      *                         X3.135-1989
      *
      *                  SECTION 6.6 <unique constraint definition>
      *                  SECTION 8.7  <insert statement>
      *                  SECTION 8.10 <select statement>
      *                  SECTION 8.12 <update statement: searched>
      *
      ****************************************************************

           EXEC SQL BEGIN DECLARE SECTION END-EXEC
       01  jj PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  i PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  ii PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  city1 PIC  X(15).
       01  tuser1 PIC  X(110).
       01  tuser2 PIC  X(110).
       01  uid PIC X(18).
       01  uidx PIC X(18).
           EXEC SQL END DECLARE SECTION END-EXEC
       01  SQLCODE PIC S9(9) COMP.
       01  errcnt PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
       01  iii 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
           EXEC SQL SELECT
                 USER INTO :uidx FROM HU.ECCO END-EXEC
           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, Embedded COBOL, dml058.pco"
           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 TEST0251 *******************

           DISPLAY " TEST0251 "
           DISPLAY " COMMIT WORK "
           DISPLAY " reference X3.135-1989 section 8.2 General
      -    " Rules. 3"
           DISPLAY " - - - - - - - - - - - - - - - - - - - - - "
           DISPLAY  " "
           DISPLAY " DELETE FROM STAFF1;"
           DISPLAY  " "
           DISPLAY " INSERT INTO STAFF1"
           DISPLAY " SELECT * FROM STAFF;"
           DISPLAY  " "
           DISPLAY " SELECT COUNT(*) INTO :ii"
           DISPLAY " FROM STAFF1;"
           DISPLAY  " "
           DISPLAY " INSERT INTO STAFF1"
           DISPLAY " VALUES ('E9','Tom',50,'London');"
           DISPLAY  " "
           DISPLAY " UPDATE STAFF1"
           DISPLAY " SET GRADE = 40"
           DISPLAY " WHERE EMPNUM = 'E2';"
           DISPLAY " COMMIT WORK;"
           DISPLAY  " "
           DISPLAY " DELETE FROM STAFF1;"
           DISPLAY " ROLLBACK WORK; "
           DISPLAY  " "
           DISPLAY " SELECT COUNT(*) INTO :i"
           DISPLAY " FROM STAFF1"
           DISPLAY " WHERE GRADE > 12;"

           MOVE 0 TO ii
           MOVE 0 TO i
           EXEC SQL DELETE FROM STAFF1 END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL INSERT INTO STAFF1
             SELECT  * FROM STAFF END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL SELECT COUNT(*) INTO :ii
             FROM STAFF1 END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL INSERT INTO STAFF1
             VALUES ('E9','Tom',50,'London') END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL UPDATE STAFF1
             SET GRADE = 40
             WHERE EMPNUM = 'E2' END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL COMMIT WORK END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL DELETE FROM STAFF1 END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL ROLLBACK WORK END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL SELECT COUNT(*) INTO :i
             FROM STAFF1
             WHERE GRADE > 12 END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL DELETE FROM STAFF1 END-EXEC
           MOVE SQLCODE TO SQL-COD
           DISPLAY " The correct answer is :"
           DISPLAY " ii is 5"
           DISPLAY " i is 4"
           DISPLAY " Your answer is :"
           DISPLAY " ii is ", ii
           DISPLAY " i is ", i
           if (ii  =  5  AND  i  =  4) then
             EXEC SQL INSERT INTO TESTREPORT
               VALUES('0251','pass','PCO') END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY " *** pass *** "
           else
             EXEC SQL INSERT INTO TESTREPORT
               VALUES('0251','fail','PCO') END-EXEC
             ADD 1 TO errcnt
             MOVE SQLCODE TO SQL-COD
             DISPLAY " dml058.pco *** fail *** "
           END-IF
           DISPLAY "================================================"

           DISPLAY  " "
           EXEC SQL COMMIT WORK END-EXEC
           MOVE SQLCODE TO SQL-COD
      **************** END TEST 0251 **********

      ******************** BEGIN TEST0252 *******************

           DISPLAY " TEST0252 "
           DISPLAY " ROLLBACK WORK "
           DISPLAY " reference X3.135-1989 section 8.9 Gerneral
      -    " Rules 1"
           DISPLAY " - - - - - - - - - - - - - - - - - - - - - "
           DISPLAY  " "
           DISPLAY " DELETE FROM STAFF1;"
           DISPLAY  " "
           DISPLAY " INSERT INTO STAFF1"
           DISPLAY " SELECT * FROM STAFF;"
           DISPLAY " COMMIT WORK;"
           DISPLAY  " "
           DISPLAY " UPDATE STAFF1"
           DISPLAY " SET EMPNUM = 'E9'"
           DISPLAY " WHERE EMPNUM = 'E1';"
           DISPLAY  " "
           DISPLAY " ROLLBACK WORK;"
           DISPLAY  " "
           DISPLAY " SELECT COUNT(*) INTO :i"
           DISPLAY " FROM STAFF1"
           DISPLAY " WHERE EMPNUM = 'E1';"
           MOVE 0 TO i
           EXEC SQL DELETE FROM STAFF1 END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL INSERT INTO STAFF1
             SELECT * FROM STAFF END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL COMMIT WORK END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL INSERT INTO STAFF1
             VALUES ('E10','Tom',50,'London') END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL UPDATE STAFF1
             SET GRADE = 40
             WHERE EMPNUM = 'E1' END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL DELETE FROM STAFF1
             WHERE EMPNUM = 'E2' END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL ROLLBACK WORK END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL SELECT SUM(GRADE) INTO :i
             FROM STAFF1 END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL DELETE FROM STAFF1 END-EXEC
           MOVE SQLCODE TO SQL-COD
           DISPLAY " The correct answer is :"
           DISPLAY " i is 60"
           DISPLAY " Your answer is :"
           DISPLAY " i is ", i
           if (i  =  60) then
             EXEC SQL INSERT INTO TESTREPORT
               VALUES('0252','pass','PCO') END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY " *** pass *** "
           else
             EXEC SQL INSERT INTO TESTREPORT
               VALUES('0252','fail','PCO') END-EXEC
             ADD 1 TO errcnt
             MOVE SQLCODE TO SQL-COD
             DISPLAY " dml058.pco *** fail *** "
           END-IF
           DISPLAY "================================================"

           DISPLAY  " "
           EXEC SQL COMMIT WORK END-EXEC
           MOVE SQLCODE TO SQL-COD
      **************** END TEST 0252 **********

      *  EXEC SQL CREATE TABLE UPUNIQ (NUMKEY DECIMAL(3) UNIQUE,
      *                                COL2   CHAR(2));

      *  See INSERTs in program BASETAB.PCO
      *     INSERT INTO UPUNIQ VALUES(1,'A')
      *     INSERT INTO UPUNIQ VALUES(2,'B')
      *     INSERT INTO UPUNIQ VALUES(3,'C')
      *     INSERT INTO UPUNIQ VALUES(4,'D')
      *     INSERT INTO UPUNIQ VALUES(6,'F')
      *     INSERT INTO UPUNIQ VALUES(8,'H')

      ******************** BEGIN TEST0253 *******************

           DISPLAY " TEST0253 "
           DISPLAY " update (key=key+1) workaround "
           DISPLAY " reference X3.135-1989 section 8.12, 6.6 GR. 2)"
           DISPLAY " - - - - - - - - - - - - - - - - - - -"

      *Comment -- This test does not requires deferred integrity
      *     constraint checking, but has the same effect as
      *           SET NUMKEY = NUMKEY + 1

           DISPLAY  " "
           DISPLAY " DECLARE SUN CURSOR "
           DISPLAY " FOR SELECT NUMKEY FROM UPUNIQ"
           DISPLAY " ORDER BY NUMKEY DESC;"
           DISPLAY  " "
           DISPLAY " FETCH SUN INTO :jj;"
           DISPLAY  " "
           DISPLAY " UPDATE UPUNIQ"
           DISPLAY " SET NUMKEY = :jj + 1 "
           DISPLAY " WHERE NUMKEY = :jj;"
           DISPLAY  " "
           EXEC SQL DECLARE SUN CURSOR
             FOR SELECT NUMKEY FROM UPUNIQ
             ORDER BY NUMKEY DESC END-EXEC

           EXEC SQL OPEN SUN END-EXEC
           MOVE SQLCODE TO SQL-COD

           MOVE 0 TO i
           PERFORM P50 UNTIL i > 9
           EXEC SQL CLOSE SUN END-EXEC
           MOVE SQLCODE TO SQL-COD
           MOVE 0 TO i
           MOVE 0 TO ii
           EXEC SQL SELECT MAX(NUMKEY), MIN(NUMKEY)
             INTO   :i,:ii
             FROM   UPUNIQ END-EXEC
           MOVE SQLCODE TO SQL-COD
           DISPLAY " The max numkey in table UPUNIQ is ", i ". "
           DISPLAY " The min numkey in table UPUNIQ is ", ii ". "

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

           if (i  =  9  AND  ii  =  2) then
             DISPLAY " *** pass *** "
             EXEC SQL INSERT INTO TESTREPORT
               VALUES('0253','pass','PCO') END-EXEC
             MOVE SQLCODE TO SQL-COD
           else
             DISPLAY " dml058.pco *** fail *** "
             EXEC SQL INSERT INTO TESTREPORT
               VALUES('0253','fail','PCO') END-EXEC
             ADD 1 TO errcnt
             MOVE SQLCODE TO SQL-COD
           END-IF

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

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

      ******************** END TEST0253 *******************

      ******************** BEGIN TEST0254 *******************

           DISPLAY " TEST0254 "
           DISPLAY " UPDATE -COLUMN SPEC. "
           DISPLAY " reference X3.135-1989 section 8.12, 5.9"
           DISPLAY " - - - - - - - - - - - - - - - - - - - - - "
           DISPLAY  " "
           DISPLAY " UPDATE PROJ1"
           DISPLAY " SET CITY = PTYPE;"
           DISPLAY  " "
           DISPLAY " SELECT CITY INTO :city1"
           DISPLAY " FROM PROJ1"
           DISPLAY " WHERE PNUM = 'P1';"
           COMPUTE iii = -1
           MOVE "NV" TO city1
           EXEC SQL DELETE FROM PROJ1 END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL INSERT INTO PROJ1
             SELECT * FROM PROJ END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL UPDATE PROJ1
             SET  CITY = PTYPE END-EXEC
           MOVE SQLCODE TO SQL-COD
           MOVE SQLCODE TO iii
           EXEC SQL SELECT CITY INTO :city1
             FROM PROJ1
             WHERE PNUM = 'P1' END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL ROLLBACK WORK END-EXEC
           MOVE SQLCODE TO SQL-COD
           DISPLAY " The correct answer is :"
           DISPLAY " iii is 0"
           DISPLAY " city1 = Design"
           DISPLAY " Your answer is :"
           DISPLAY " iii is ", iii
           DISPLAY " city1 = ", city1
           if (city1   =   "Design"  AND  iii  =  0) then
             EXEC SQL INSERT INTO TESTREPORT
               VALUES('0254','pass','PCO') END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY " *** pass *** "
           else
             EXEC SQL INSERT INTO TESTREPORT
               VALUES('0254','fail','PCO') END-EXEC
             ADD 1 TO errcnt
             MOVE SQLCODE TO SQL-COD
             DISPLAY " dml058.pco *** fail *** "
           END-IF
           DISPLAY "================================================"

           DISPLAY  " "
           EXEC SQL COMMIT WORK END-EXEC
           MOVE SQLCODE TO SQL-COD
      **************** END TEST 0254 **********

      ******************** BEGIN TEST0255 *******************
      *For INSERT, UPDATE

           DISPLAY " TEST0255 "
           DISPLAY " USER . "
           DISPLAY " reference X3.135-1989 section 8.7,8.12 & 5.6"
           DISPLAY " - - - - - - - - - - - - - - - - - - - - - "
           DISPLAY  " "
           DISPLAY  " "
           DISPLAY " INSERT INTO T4"
           DISPLAY " VALUES (USER,100,'good','luck');"
           DISPLAY  " "
           DISPLAY " SELECT STR110 INTO :tuser1 FROM T4"
           DISPLAY " WHERE NUM6 = 100;"
           DISPLAY  " "
           DISPLAY " INSERT INTO T4"
           DISPLAY " VALUES ('Hello',101,'good','luck');"
           DISPLAY  " "
           DISPLAY " UPDATE T4"
           DISPLAY " SET STR110 = USER"
           DISPLAY " WHERE NUM6 = 101;"
           DISPLAY  " "
           DISPLAY " SELECT STR110 INTO :tuser2 FROM T4"
           DISPLAY " WHERE NUM6 = 101;"
           EXEC SQL DELETE FROM T4 END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL INSERT INTO T4
             VALUES (USER,100,'good','luck') END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL SELECT STR110 INTO :tuser1 FROM T4
             WHERE NUM6 = 100 END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL INSERT INTO T4
             VALUES ('Hello',101,'good','luck') END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL UPDATE T4
             SET STR110 = USER
             WHERE NUM6 = 101 END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL SELECT STR110 INTO :tuser2 FROM T4
             WHERE NUM6 = 101 END-EXEC
           MOVE SQLCODE TO SQL-COD
           DISPLAY " The correct answer is :"
           DISPLAY " tuser1 = HU"
           DISPLAY " tuser2 = HU"
           DISPLAY " Your answer is :"
           DISPLAY " tuser1 = ", tuser1
           DISPLAY " tuser2 = ", tuser2
           EXEC SQL ROLLBACK WORK END-EXEC
           MOVE SQLCODE TO SQL-COD
           if (tuser1   =   "HU"  AND  tuser2   =   "HU") then
             EXEC SQL INSERT INTO TESTREPORT
               VALUES('0255','pass','PCO') END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY " *** pass *** "
           else
             EXEC SQL INSERT INTO TESTREPORT
               VALUES('0255','fail','PCO') END-EXEC
             ADD 1 TO errcnt
             MOVE SQLCODE TO SQL-COD
             DISPLAY " dml058.pco *** fail *** "
           END-IF
           DISPLAY "================================================"

           DISPLAY  " "
           EXEC SQL COMMIT WORK END-EXEC
           MOVE SQLCODE TO SQL-COD
      **************** END TEST 0255 **********

      ******************** BEGIN TEST0256 *******************
      *For WHERE

           DISPLAY " TEST0256 "
           DISPLAY " USER in WHERE clause. "
           DISPLAY " reference X3.135-1989 section 8.7,8.12 "
           DISPLAY " - - - - - - - - - - - - - - - - - - - - - "
           DISPLAY  " "
           DISPLAY " INSERT INTO T4"
           DISPLAY " VALUES ('HU',100,'good','luck');"
           DISPLAY  " "
           DISPLAY " SELECT STR110 INTO :tuser1 FROM T4"
           DISPLAY " WHERE STR110 = USER;"
           DISPLAY  " "
           DISPLAY " INSERT INTO T4"
           DISPLAY " VALUES ('Hello',101,'good','luck');"
           DISPLAY  " "
           DISPLAY " DELETE FROM T4"
           DISPLAY " WHERE STR110 = USER;"
           DISPLAY  " "
           DISPLAY " SELECT COUNT(*) INTO :ii FROM T4"
           DISPLAY " WHERE STR110 LIKE '%U%;"
           COMPUTE ii = -1
           EXEC SQL DELETE FROM T4 END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL INSERT INTO T4
             VALUES ('HU',100,'good','luck') END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL SELECT STR110 INTO :tuser1 FROM T4
             WHERE STR110 = USER END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL INSERT INTO T4
             VALUES ('Hello',101,'good','luck') END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL DELETE FROM T4
             WHERE STR110 = USER END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL SELECT COUNT(*) INTO :ii FROM T4
             WHERE STR110 LIKE '%HU%' END-EXEC
           MOVE SQLCODE TO SQL-COD
           DISPLAY " The correct answer is :"
           DISPLAY " tuser1 = HU"
           DISPLAY " ii = 0"
           DISPLAY " Your answer is :"
           DISPLAY " tuser1 = ", tuser1
           DISPLAY " ii = ", ii
           EXEC SQL ROLLBACK WORK END-EXEC
           MOVE SQLCODE TO SQL-COD
           if (tuser1   =   "HU"  AND  ii  =  0) then
             EXEC SQL INSERT INTO TESTREPORT
               VALUES('0256','pass','PCO') END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY " *** pass *** "
           else
             EXEC SQL INSERT INTO TESTREPORT
               VALUES('0256','fail','PCO') END-EXEC
             ADD 1 TO errcnt
             MOVE SQLCODE TO SQL-COD
             DISPLAY " dml058.pco *** fail *** "
           END-IF
           DISPLAY "================================================"

           DISPLAY  " "
           EXEC SQL COMMIT WORK END-EXEC
           MOVE SQLCODE TO SQL-COD
      **************** END TEST 0256 **********

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

      *    ****  Procedures for PERFORM statements

        P50.
             EXEC SQL FETCH SUN INTO :jj END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL UPDATE UPUNIQ
               SET NUMKEY = :jj + 1
               WHERE NUMKEY = :jj END-EXEC
             MOVE SQLCODE TO SQL-COD
           ADD 1 TO i
           .

quality100%

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