Quelle cdr024.cob Sprache: Cobol

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

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

      ****************************************************************
      *
      *                 COMMENT SECTION
      *
      * DATE 1989/04/07 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.
      *
      * CDR024.SCO
      * WRITTEN BY: SUN DAJUN
      *
      *   THIS ROUTINE TESTS THE <DEFAULT CLAUSE> IN COLUMN DEFINI-
      * TION.
      *
      * REFERENCES
      *       AMERICAN NATIONAL STANDARD database language - SQL
      *                          with Integrity Enhancement
      *
      *            SECTION 6.3
      *               <column definition>::=
      *                         <column name><data type>
      *                         (<default clause>)
      *                         (<column constrait>...)
      *            SECTION 6.4
      *               <default clause>::=
      *                         DEFAULT {<literal>|USER|NULL}
      *
      ****************************************************************

      * EXEC SQL BEGIN DECLARE SECTION END-EXEC
       01  SEX1 PIC  X(1).
       01  NICK1 PIC  X(20).
       01  INSUR1 PIC  X(5).
       01  BODY1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  MAX1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  MIN1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  CNT PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
      *  EXEC SQL END DECLARE SECTION END-EXEC

       01  uid PIC  X(18).
       01  uidx PIC X(18).
       01  flag PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  SQLCODE PIC S9(9) COMP.
       01  errcnt PIC S9(4) 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 "SUN" TO uid
             CALL "AUTHID" USING uid
           MOVE "not logged in, not" TO uidx
           CALL "AUTHCK" USING SQLCODE uidx
           MOVE SQLCODE TO SQL-COD
           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, Module COBOL, cdr024.sco"
           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 TEST0385 *******************
      *This program tests if character string default
      *values of columns can be properly set.

             DISPLAY " TEST0385 "
             DISPLAY " Char. column default value "
             DISPLAY " SQL with Integrity Enhancement section
      -    " 6.3,6.4"
             DISPLAY " - - - - - - - - - - - - - - - - - - - - - "
             DISPLAY " DELETE FROM CHAR_DEFAULT;"
             DISPLAY  " "
             DISPLAY " INSERT INTO CHAR_DEFAULT(SEX_CODE)"
             DISPLAY " VALUES ('M');"
             DISPLAY " "
             DISPLAY " "
             DISPLAY " SELECT NICKNAME, INSURANCE1 INTO :NICK1,
      -    " :INSUR1 "
             DISPLAY " FROM CHAR_DEFAULT"
             DISPLAY " WHERE SEX_CODE = 'M';"
             DISPLAY  " "
             DISPLAY " INSERT INTO CHAR_DEFAULT(NICKNAME,
      -    " INSURANCE1)"
             DISPLAY " VALUES ('Piggy', 'Kaise');"
             DISPLAY " "
             DISPLAY " "
             DISPLAY " SELECT SEX_CODE INTO :SEX1 "
             DISPLAY " FROM CHAR_DEFAULT"
             DISPLAY " WHERE INSURANCE1 = 'Kaise';"

             MOVE "NV" TO INSUR1
             MOVE "NV" TO NICK1
             MOVE " " TO SEX1
      *  EXEC SQL DELETE FROM CHAR_DEFAULT END-EXEC
             CALL "SUB1" USING SQLCODE
             MOVE SQLCODE TO SQL-COD

      *  EXEC SQL INSERT INTO CHAR_DEFAULT(SEX_CODE)
      *    VALUES ('M') END-EXEC
             CALL "SUB2" USING SQLCODE
             MOVE SQLCODE TO SQL-COD

      *  EXEC SQL SELECT NICKNAME, INSURANCE1 INTO :NICK1, :INSUR1
      *    FROM CHAR_DEFAULT
      *    WHERE SEX_CODE = 'M' END-EXEC
             CALL "SUB3" USING SQLCODE NICK1 INSUR1
             MOVE SQLCODE TO SQL-COD

      *  EXEC SQL INSERT INTO CHAR_DEFAULT(NICKNAME, INSURANCE1)
      *    VALUES ('Piggy', 'Kaise') END-EXEC
             CALL "SUB4" USING SQLCODE
             MOVE SQLCODE TO SQL-COD

      *  EXEC SQL SELECT SEX_CODE INTO :SEX1
      *    FROM CHAR_DEFAULT
      *    WHERE INSURANCE1 = 'Kaise' END-EXEC
             CALL "SUB5" USING SQLCODE SEX1
             MOVE SQLCODE TO SQL-COD

             DISPLAY "The correct result is :"
             DISPLAY " SEX1 = F, NICK1 = No nickname given"
             DISPLAY " INSUR1 = basic"
             DISPLAY "Your answer is :"
             DISPLAY " SEX1 = ", SEX1 ", NICK1 = ", NICK1
             DISPLAY " INSUR1 = ", INSUR1
             if (SEX1   =   "F"  AND  NICK1   =   "No nickname given")
             then
               MOVE 1 TO flag
             else
               MOVE 0 TO flag
             END-IF
             if (flag  =  1  AND  INSUR1   =   "basic") then
      *    EXEC SQL INSERT INTO TESTREPORT
      *      VALUES('0385','pass','MCO') END-EXEC
               CALL "SUB6" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
               DISPLAY " *** pass *** "
             else
      *    EXEC SQL INSERT INTO TESTREPORT
      *      VALUES('0385','fail','MCO') END-EXEC
             ADD 1 TO errcnt
               CALL "SUB7" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
               DISPLAY " cdr024.sco *** fail *** "
             END-IF
             DISPLAY "================================================"

             DISPLAY  " "
      *  EXEC SQL COMMIT WORK END-EXEC
             CALL "SUB8" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
      ****************** END TEST0385 ***********************

      ******************** BEGIN TEST0386 *******************
      *This program tests if exact numeric default values
      *of columns can be properly set.

             DISPLAY " TEST0386 "
             DISPLAY " Exact numeric column default value "
             DISPLAY " SQL with Integrity Enhancement section
      -    " 6.3,6.4"
             DISPLAY " - - - - - - - - - - - - - - - - - - - - - "
             DISPLAY  " "
             DISPLAY " DELETE FROM EXACT_DEF;"
             DISPLAY  " "
             DISPLAY " INSERT INTO EXACT_DEF"
             DISPLAY " VALUES (98.3, -55556, .000001);"
             DISPLAY  " "
             DISPLAY " INSERT INTO EXACT_DEF(BODY_TEMP)"
             DISPLAY " VALUES (99.0);"
             DISPLAY " "
             DISPLAY " "
             DISPLAY " INSERT INTO EXACT_DEF(MAX_NUM, MIN_NUM)"
             DISPLAY " VALUES (100, .2);"
             DISPLAY " "
             DISPLAY " "
             DISPLAY " SELECT COUNT(*) INTO :CNT "
             DISPLAY " FROM EXACT_DEF"
             DISPLAY " WHERE BODY_TEMP = 99.0 AND "
             DISPLAY " MAX_NUM = -55555 AND MIN_NUM = .000001"
             DISPLAY " OR BODY_TEMP = 98.6 AND MAX_NUM = 100 AND
      -    " MIN_NUM = .2;"

             MOVE 0 TO CNT
      *  EXEC SQL DELETE FROM EXACT_DEF END-EXEC
             CALL "SUB9" USING SQLCODE
             MOVE SQLCODE TO SQL-COD

      *  EXEC SQL INSERT INTO EXACT_DEF
      *    VALUES (98.3, -55556, .000001) END-EXEC
             CALL "SUB10" USING SQLCODE
             MOVE SQLCODE TO SQL-COD

      *  EXEC SQL INSERT INTO EXACT_DEF(BODY_TEMP)
      *    VALUES (99.0) END-EXEC
             CALL "SUB11" USING SQLCODE
             MOVE SQLCODE TO SQL-COD

      *  EXEC SQL INSERT INTO EXACT_DEF(MAX_NUM, MIN_NUM)
      *    VALUES (100, .2) END-EXEC
             CALL "SUB12" USING SQLCODE
             MOVE SQLCODE TO SQL-COD

      *  EXEC SQL SELECT COUNT(*) INTO :CNT
      *    FROM EXACT_DEF
      *    WHERE BODY_TEMP = 99.0 AND
      *    MAX_NUM = -55555 AND MIN_NUM = .000001
      *    OR BODY_TEMP = 98.6 AND MAX_NUM = 100 AND MIN_NUM = .2
      *  END-EXEC
             CALL "SUB13" USING SQLCODE CNT
             MOVE SQLCODE TO SQL-COD

             DISPLAY "The correct result is :"
             DISPLAY " CNT = 2"
             DISPLAY "Your answer is :"
             DISPLAY " CNT = ", CNT

             if (CNT  =  2) then
      *    EXEC SQL INSERT INTO TESTREPORT
      *      VALUES('0386','pass','MCO') END-EXEC
               CALL "SUB14" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
               DISPLAY " *** pass *** "
             else
      *    EXEC SQL INSERT INTO TESTREPORT
      *      VALUES('0386','fail','MCO') END-EXEC
             ADD 1 TO errcnt
               CALL "SUB15" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
               DISPLAY " cdr024.sco *** fail *** "
             END-IF
             DISPLAY "================================================"

             DISPLAY  " "
      *  EXEC SQL COMMIT WORK END-EXEC
             CALL "SUB16" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
      ********************* END TEST0386 *******************

      ******************** BEGIN TEST0387 *******************
      *This program tests if approximate numeric default
      *values of columns can be properly set.

             DISPLAY " TEST0387 "
             DISPLAY " Approximate numeric column default value
      -    " "
             DISPLAY " SQL with Integrity Enhancement section
      -    " 6.3,6.4"
             DISPLAY " - - - - - - - - - - - - - - - - - - - - - "

             DISPLAY  " "
             DISPLAY " DELETE FROM APPROX_DEF;"
             DISPLAY  " "
             DISPLAY " INSERT INTO APPROX_DEF(X_COUNT)"
             DISPLAY " VALUES (5.0E5);"
             DISPLAY " "
             DISPLAY " INSERT INTO APPROX_DEF"
             DISPLAY " VALUES (1.78E11, -9.9E10, 3.45E-10,
      -    " 7.6777E-7);"
             DISPLAY " "
             DISPLAY " INSERT INTO APPROX_DEF(Y_COUNT, Z_COUNT,
      -    " ZZ_COUNT)"
             DISPLAY " VALUES (1.0E3, 2.0E4, 3.8E6);"
             DISPLAY " "
             DISPLAY " SELECT COUNT(*) INTO :CNT"
             DISPLAY " FROM APPROX_DEF"
             DISPLAY " WHERE (Y_COUNT BETWEEN -9.991E10 AND
      -    " -9.989E10) AND"
             DISPLAY " (Z_COUNT BETWEEN 3.44E-11 AND
      -    " 3.46E-11) AND"
             DISPLAY " (ZZ_COUNT BETWEEN -7.6778E-7 AND
      -    " -7.6776E-7) OR"
             DISPLAY " (X_COUNT BETWEEN 1.77E12 AND
      -    " 1.79E12);"
             DISPLAY  " "
             MOVE 0 TO CNT
      *  EXEC SQL DELETE FROM APPROX_DEF END-EXEC
             CALL "SUB17" USING SQLCODE
             MOVE SQLCODE TO SQL-COD

      *  EXEC SQL INSERT INTO APPROX_DEF(X_COUNT)
      *    VALUES (5.0E5) END-EXEC
             CALL "SUB18" USING SQLCODE
             MOVE SQLCODE TO SQL-COD

      *  EXEC SQL INSERT INTO APPROX_DEF
      *    VALUES (1.78E11, -9.9E10, 3.45E-10, 7.6777E-7) END-EXEC
             CALL "SUB19" USING SQLCODE
             MOVE SQLCODE TO SQL-COD

      *  EXEC SQL INSERT INTO APPROX_DEF(Y_COUNT, Z_COUNT, ZZ_COUNT)
      *    VALUES (1.0E3, 2.0E4, 3.8E6) END-EXEC
             CALL "SUB20" USING SQLCODE
             MOVE SQLCODE TO SQL-COD

      *  EXEC SQL SELECT COUNT(*) INTO :CNT
      *    FROM APPROX_DEF
      *    WHERE (Y_COUNT BETWEEN -9.991E10 AND -9.989E10) AND
      *    (Z_COUNT BETWEEN 3.44E-11 AND 3.46E-11) AND
      *    (ZZ_COUNT BETWEEN -7.6778E-7 AND -7.6776E-7) OR
      *    (X_COUNT BETWEEN 1.77E12 AND 1.79E12) END-EXEC
             CALL "SUB21" USING SQLCODE CNT
             MOVE SQLCODE TO SQL-COD

             DISPLAY "The correct result is :"
             DISPLAY " CNT = 2"
             DISPLAY "Your answer is :"
             DISPLAY " CNT = ", CNT

             if (CNT  =  2) then
      *    EXEC SQL INSERT INTO TESTREPORT
      *      VALUES('0387','pass','MCO') END-EXEC
               CALL "SUB22" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
               DISPLAY " *** pass *** "
             else
      *    EXEC SQL INSERT INTO TESTREPORT
      *      VALUES('0387','fail','MCO') END-EXEC
             ADD 1 TO errcnt
               CALL "SUB23" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
               DISPLAY " cdr024.sco *** fail *** "
             END-IF
             DISPLAY "================================================"

             DISPLAY  " "
      *  EXEC SQL COMMIT WORK END-EXEC
             CALL "SUB24" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
      ****************** END TEST0387 *********************

      ******************** BEGIN TEST0388 *******************
      *This program tests if the FIPS sizing default values
      *of columns can be properly set.
      *
      * !!!!!!!!!! SEE COBOL TEST0206 FOR REFERENCE !!!!!!!!
      *

             DISPLAY " TEST0388 "
             DISPLAY " Default value sizing test"
             DISPLAY " SQL with Integrity Enhancement section
      -    " 6.3,6.4"
             DISPLAY " - - - - - - - - - - - - - - - - - - - - - "
             DISPLAY  " "
             DISPLAY " DELETE FROM SIZE_TAB;"
             DISPLAY  " "
             DISPLAY " INSERT INTO SIZE_TAB(COL1) VALUES("
             DISPLAY "
      -    " 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnop"
             DISPLAY " qrstuvwxyz0123456789012');"
             DISPLAY " "
             DISPLAY " INSERT INTO SIZE_TAB(COL2, COL3, COL4)"
             DISPLAY " VALUES (-999888777, 987654321.123456,
      -    " -1.45E22);"
             DISPLAY  " "
             DISPLAY " INSERT INTO SIZE_TAB"
             DISPLAY " VALUES('ABCDEFG', 7,7,-1.49E22);"
             DISPLAY " "
             DISPLAY " DECLARE MOON CURSOR FOR "
             DISPLAY " SELECT COUNT(*) FROM SIZE_TAB"
             DISPLAY " WHERE COL4 BETWEEN -1.46E22 AND
      -    " -1.048575E22"
             DISPLAY " GROUP BY COL1, COL2, COL3;"
             DISPLAY  " "
             MOVE 0 TO CNT
      *  EXEC SQL DELETE FROM SIZE_TAB END-EXEC
             CALL "SUB25" USING SQLCODE
      *  EXEC SQL INSERT INTO SIZE_TAB(COL1)
      *       VALUES ('ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghi
      * -                   "jklmnopqrstuvwxyz0123456789012') END-EXEC
             CALL "SUB26" USING SQLCODE

             MOVE SQLCODE TO SQL-COD

      *  EXEC SQL INSERT INTO SIZE_TAB(COL2, COL3, COL4)
      *    VALUES (-999888777, 987654321.123456, -1.45E22) END-EXEC
             CALL "SUB27" USING SQLCODE
             MOVE SQLCODE TO SQL-COD

      *  EXEC SQL DECLARE MOON CURSOR FOR
      *    SELECT COUNT(*)  FROM SIZE_TAB
      *    WHERE COL4 BETWEEN -1.46E22 AND -1.048575E22
      *    GROUP BY COL1, COL2, COL3 END-EXEC

      *  EXEC SQL INSERT INTO SIZE_TAB
      *    VALUES('ABCDEFG', 7,7,-1.49E22) END-EXEC
             CALL "SUB28" USING SQLCODE
             MOVE SQLCODE TO SQL-COD

      *  EXEC SQL OPEN MOON END-EXEC
             CALL "SUB29" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
      *  EXEC SQL FETCH MOON INTO :CNT END-EXEC
             CALL "SUB30" USING SQLCODE CNT
             MOVE SQLCODE TO SQL-COD
      *  EXEC SQL CLOSE MOON END-EXEC
             CALL "SUB31" USING SQLCODE
             MOVE SQLCODE TO SQL-COD

             DISPLAY "The correct result is :"
             DISPLAY " CNT = 2 "
             DISPLAY "Your answer is :"
             DISPLAY " CNT = ", CNT

             if (CNT  =  2) then
      *    EXEC SQL INSERT INTO TESTREPORT
      *      VALUES('0388','pass','MCO') END-EXEC
               CALL "SUB32" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
               DISPLAY " *** pass *** "
             else
      *    EXEC SQL INSERT INTO TESTREPORT
      *      VALUES('0388','fail','MCO') END-EXEC
             ADD 1 TO errcnt
               CALL "SUB33" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
               DISPLAY " cdr024.sco *** fail *** "
             END-IF
             DISPLAY "================================================"

             DISPLAY  " "
      *  EXEC SQL COMMIT WORK END-EXEC
             CALL "SUB34" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
      ******************** END TEST0388 ********************

      **** 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.