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.


      * Embedded SQL COBOL ("CDR024.PCO") translated from
      * Embedded C on Wed Jan 16 10:18:33 1991.


      ****************************************************************
      *                                                              
      *                 COMMENT SECTION                              
      *                                                              
      * DATE 1989/04/07 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.
      *                                                              
      * CDR024.PCO                                                    
      * 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.
       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  flag 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 "SUN" TO uid
             CALL "AUTHID" USING uid
           MOVE "not logged in, not" TO uidx
           EXEC SQL SELECT 
                 USER INTO :uidx FROM SUN.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, cdr024.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 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
             MOVE SQLCODE TO SQL-COD

             EXEC SQL INSERT INTO CHAR_DEFAULT(SEX_CODE)
               VALUES ('M') END-EXEC
             MOVE SQLCODE TO SQL-COD


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

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


             EXEC SQL SELECT SEX_CODE INTO :SEX1 
               FROM CHAR_DEFAULT
               WHERE INSURANCE1 = 'Kaise' END-EXEC
             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','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
               DISPLAY " *** pass *** "
             else
               EXEC SQL INSERT INTO TESTREPORT
                 VALUES('0385','fail','PCO') END-EXEC
             ADD 1 TO errcnt
               MOVE SQLCODE TO SQL-COD
               DISPLAY " cdr024.pco *** fail *** "
             END-IF
             DISPLAY "================================================"

             DISPLAY  " "
             EXEC SQL COMMIT WORK END-EXEC
             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
             MOVE SQLCODE TO SQL-COD

             EXEC SQL INSERT INTO EXACT_DEF
               VALUES (98.3, -55556, .000001) END-EXEC
             MOVE SQLCODE TO SQL-COD

             EXEC SQL INSERT INTO EXACT_DEF(BODY_TEMP)
               VALUES (99.0) END-EXEC
             MOVE SQLCODE TO SQL-COD


             EXEC SQL INSERT INTO EXACT_DEF(MAX_NUM, MIN_NUM)
               VALUES (100, .2) END-EXEC
             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
             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','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
               DISPLAY " *** pass *** "
             else
               EXEC SQL INSERT INTO TESTREPORT
                 VALUES('0386','fail','PCO') END-EXEC
             ADD 1 TO errcnt
               MOVE SQLCODE TO SQL-COD
               DISPLAY " cdr024.pco *** fail *** "
             END-IF
             DISPLAY "================================================"

             DISPLAY  " "
             EXEC SQL COMMIT WORK END-EXEC
             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
             MOVE SQLCODE TO SQL-COD

             EXEC SQL INSERT INTO APPROX_DEF(X_COUNT)
               VALUES (5.0E5) END-EXEC
             MOVE SQLCODE TO SQL-COD

             EXEC SQL INSERT INTO APPROX_DEF
               VALUES (1.78E11, -9.9E10, 3.45E-10, 7.6777E-7) END-EXEC
             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
             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
             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','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
               DISPLAY " *** pass *** "
             else
               EXEC SQL INSERT INTO TESTREPORT
                 VALUES('0387','fail','PCO') END-EXEC
             ADD 1 TO errcnt
               MOVE SQLCODE TO SQL-COD
               DISPLAY " cdr024.pco *** fail *** "
             END-IF
             DISPLAY "================================================"

             DISPLAY  " "
             EXEC SQL COMMIT WORK END-EXEC
             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
             EXEC SQL INSERT INTO SIZE_TAB(COL1) 
                  VALUES ('ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghi
      -                   'jklmnopqrstuvwxyz0123456789012') END-EXEC

             MOVE SQLCODE TO SQL-COD

             EXEC SQL INSERT INTO SIZE_TAB(COL2, COL3, COL4)
               VALUES (-999888777, 987654321.123456, -1.45E22) END-EXEC
             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
             MOVE SQLCODE TO SQL-COD

             EXEC SQL OPEN MOON END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL FETCH MOON INTO :CNT END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL CLOSE MOON END-EXEC
             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','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
               DISPLAY " *** pass *** "
             else
               EXEC SQL INSERT INTO TESTREPORT
                 VALUES('0388','fail','PCO') END-EXEC
             ADD 1 TO errcnt
               MOVE SQLCODE TO SQL-COD
               DISPLAY " cdr024.pco *** fail *** "
             END-IF
             DISPLAY "================================================"

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




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

      *    ****  Procedures for PERFORM statements