Ziele Untersuchung
mit Columbo Integrität von
Datenbanken Interaktion und
Portierbarkeit Ergonomie der
Schnittstellen

Angebot Produkte Projekt Beratung

Mittel Analytik Modellierung Sprachen Algebra Logik Hardware Denken Kreativität

Zusammenhänge Gesellschaft Wirtschaft Branche Firma


products/Sources/formale Sprachen/Cobol/Test-Suite/SQL M/ Datei vom 4.1.2008 mit Größe 19 kB

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.

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

      ****************************************************************
      *
      *                 COMMENT SECTION
      *
      * DATE 1992/07/13 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.
      *
      * DML090.SCO
      * 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;
             CALL "SUB1" USING SQLCODE uidx
             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, Standard COBOL, dml090.sco"
           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);
             CALL "SUB2" USING SQLCODE PTYPE1 kk jj
             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;
             CALL "SUB3" USING SQLCODE ii jj kk
             MOVE SQLCODE TO SQL-COD
      *  EXEC SQL FETCH ZZZ INTO :CITY1, :LONG1;
             CALL "SUB4" USING SQLCODE CITY1 LONG1
             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;
             CALL "SUB5" USING SQLCODE CITY1 LONG1
             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;
             CALL "SUB6" USING SQLCODE CITY1 LONG1
             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;
             CALL "SUB7" USING SQLCODE
             MOVE SQLCODE TO SQL-COD

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0512','pass','MCO');
               CALL "SUB8" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml090.sco *** fail *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0512','fail','MCO');
               CALL "SUB9" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
             END-IF

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

      *  EXEC SQL COMMIT WORK;
             CALL "SUB10" USING SQLCODE
             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;
             CALL "SUB11" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
      *  EXEC SQL INSERT INTO TEMP_OBSERV (YEAR_OBSERV)
      *    VALUES (9999);
             CALL "SUB12" USING SQLCODE
             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);
             CALL "SUB13" USING SQLCODE
             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;
             CALL "SUB14" USING SQLCODE
             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);
             CALL "SUB15" USING SQLCODE
             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;
             CALL "SUB16" USING SQLCODE LONG1
             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);
             CALL "SUB17" USING SQLCODE
             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;
             CALL "SUB18" USING SQLCODE
             MOVE SQLCODE TO SQL-COD

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0513','pass','MCO');
               CALL "SUB19" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml090.sco *** fail *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0513','fail','MCO');
               CALL "SUB20" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
             END-IF

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

      *  EXEC SQL COMMIT WORK;
             CALL "SUB21" USING SQLCODE
             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
      * ;
             CALL "SUB22" USING SQLCODE LONG1 kk ii jj
             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';
             CALL "SUB23" USING SQLCODE PTYPE1 CITY1
             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;
             CALL "SUB24" USING SQLCODE jj
             MOVE SQLCODE TO SQL-COD
      *  EXEC SQL FETCH KKK INTO :CITY1, :LONG1;
             CALL "SUB25" USING SQLCODE CITY1 LONG1
             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;
             CALL "SUB26" USING SQLCODE
             MOVE SQLCODE TO SQL-COD

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0523','pass','MCO');
               CALL "SUB27" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml090.sco *** fail *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0523','fail','MCO');
               CALL "SUB28" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
             END-IF

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

      *  EXEC SQL COMMIT WORK;
             CALL "SUB29" USING SQLCODE
             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;
             CALL "SUB30" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
      *  EXEC SQL FETCH P_JONES INTO :PTYPE1, :LONG1;
             CALL "SUB31" USING SQLCODE PTYPE1 LONG1
             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;
             CALL "SUB32" USING SQLCODE
             MOVE SQLCODE TO SQL-COD

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0564','pass','MCO');
               CALL "SUB33" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml090.sco *** fail *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0564','fail','MCO');
               CALL "SUB34" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
             END-IF

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

      *  EXEC SQL COMMIT WORK;
             CALL "SUB35" USING SQLCODE
             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) ¤

Normalansicht

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.