SSL dml055.cob   Interaktion und
PortierbarkeitCobol

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


      * EMBEDDED COBOL (file "DML055.PCO")  

      ****************************************************************
      *                                                              
      *                 COMMENT SECTION                              
      *                                                              
      * DATE 1988/02/10 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.
      *                                                              
      * DML055.PCO                                                    
      * WRITTEN BY: SUN DAJUN                                        
      * TRANSLATED AUTOMATICALLY FROM EMBEDDED C BY CHRIS SCHANZLE
      *                                                              
      *    THIS ROUTINE TESTS THE LIMIT ON THE PRECISION OF VARIOUS  
      *    DATA TYPES.                                               
      *                                                              
      * REFERENCES                                                   
      *       AMERICAN NATIONAL STANDARD database language - SQL     
      *                         X3.135-1989                          
      *                                                              
      *       FIPS PUB 127-1, Section 13.5                           
      *       Sizing for database constructs                         
      *                                                              
      *                                                              
      ****************************************************************



           EXEC SQL BEGIN DECLARE SECTION END-EXEC
       01  count1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  count2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  float1 PIC S9V9(15) USAGE DISPLAY SIGN LEADING SEPARATE.
       01  float2 PIC S9V9(15) USAGE IS 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  code1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  code2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  t1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  t2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  f1 PIC S9V9(15).
       01  f2 PIC S9V9(15).
       01  FLOAT-DSP PIC -9.9(15).
       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, dml055.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 TEST0243 *******************

           DISPLAY " FIPS sizing TEST0243"
           DISPLAY "reference: X3.135-1989 5.5 FIPS PUB 127-1 Section
      -    " 13.5"
           DISPLAY " The precision of SMALLINT is at least 4 digits"
           DISPLAY " - - - - - - - - - - - - - - - - - - -"
           DISPLAY " *** CREATE TABLE HH (SMALLTEST SMALLINT) "
           DISPLAY " INSERT INTO HH "
           DISPLAY " VALUES(9999);"
           DISPLAY  " "
           DISPLAY " SELECT COUNT(*) INTO :count1 FROM HH"
           DISPLAY " WHERE SMALLTEST = 9999; "
           DISPLAY  " "
           DISPLAY " INSERT INTO HH "
           DISPLAY " VALUES(-9999);"
           DISPLAY  " "
           DISPLAY " SELECT SMALLTEST INTO :count2 FROM HH"
           DISPLAY " WHERE SMALLTEST = -9999; "
           DISPLAY  " "

           EXEC SQL DELETE FROM HH END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL INSERT INTO HH 
             VALUES(9999) END-EXEC
           MOVE SQLCODE TO SQL-COD
           MOVE SQLCODE TO code1
           MOVE 0 TO count1
           EXEC SQL SELECT COUNT(*) INTO :count1 FROM HH
             WHERE SMALLTEST = 9999 END-EXEC
           MOVE SQLCODE TO SQL-COD

           EXEC SQL INSERT INTO HH 
             VALUES(-9999) END-EXEC
           MOVE SQLCODE TO SQL-COD
           MOVE SQLCODE TO code2
           MOVE 0 TO count2
           EXEC SQL SELECT SMALLTEST INTO :count2 FROM HH
             WHERE SMALLTEST = -9999 END-EXEC
           MOVE SQLCODE TO SQL-COD


           DISPLAY "The correct answer should be:"
           DISPLAY " code1 = 0, code2 = 0 "
           DISPLAY " count1 = 1,count2 = -9999"

           DISPLAY "Your answer is:"
           DISPLAY " code1 = ", code1 ",code2 = ", code2
           DISPLAY " count1 = ", count1 ",count2 = ",
             count2

           EXEC SQL ROLLBACK WORK END-EXEC
           MOVE SQLCODE TO SQL-COD
           if (code1  =  0  AND  code2  =  0  AND  count1  =  1  AND 
             count2  =  -9999) then
             EXEC SQL INSERT INTO TESTREPORT
               VALUES('0243','pass','PCO') END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY " *** pass *** "
           else
             EXEC SQL INSERT INTO TESTREPORT
               VALUES('0243','fail','PCO') END-EXEC
             ADD 1 TO errcnt
             MOVE SQLCODE TO SQL-COD
             DISPLAY " dml055.pco *** fail *** "
           END-IF
           DISPLAY "================================================"

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

      ******************** END TEST0243 *******************



      ******************** BEGIN TEST0244 *******************

           DISPLAY " FIPS sizing TEST0244"
           DISPLAY "reference: X3.135-1989 5.5 FIPS PUB 127-1 Section
      -    " 13.5"
           DISPLAY " The precision of INTEGER is at least 9 digits"
           DISPLAY " - - - - - - - - - - - - - - - - - - -"
           DISPLAY " *** CREATE TABLE EE (INTTEST INTEGER) "
           DISPLAY " INSERT INTO EE "
           DISPLAY " VALUES(999999999);"
           DISPLAY  " "
           DISPLAY " SELECT INTTEST INTO :count1"
           DISPLAY " FROM EE"
           DISPLAY " WHERE INTTEST = 999999999;"
           DISPLAY  " "
           DISPLAY " INSERT INTO EE "
           DISPLAY " VALUES(-999999999);"
           DISPLAY  " "
           DISPLAY " SELECT COUNT(*) INTO :count2"
           DISPLAY " FROM EE"
           DISPLAY " WHERE INTTEST = -999999999;"
           DISPLAY  " "
           MOVE 0 TO count1
           MOVE 0 TO count2

           EXEC SQL DELETE FROM EE END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL INSERT INTO EE 
             VALUES(999999999) END-EXEC
           MOVE SQLCODE TO SQL-COD
           MOVE SQLCODE TO code1

           EXEC SQL SELECT INTTEST INTO :count1
             FROM EE
             WHERE INTTEST = 999999999 END-EXEC
           MOVE SQLCODE TO SQL-COD

           EXEC SQL INSERT INTO EE 
             VALUES(-999999999) END-EXEC
           MOVE SQLCODE TO SQL-COD
           MOVE SQLCODE TO code2

           EXEC SQL SELECT COUNT(*) INTO :count2
             FROM EE
             WHERE INTTEST = -999999999 END-EXEC
           MOVE SQLCODE TO SQL-COD

           DISPLAY "The correct answer should be:"
           DISPLAY " code1 = 0, code2 = 0 "
           DISPLAY " count1 = 999999999,count2 = 1"

           DISPLAY "Your answer is:"
           DISPLAY " code1 = ", code1 ",code2 = ", code2
           DISPLAY " count1 = ", count1 ",count2 = ",
             count2

           EXEC SQL ROLLBACK WORK END-EXEC
           MOVE SQLCODE TO SQL-COD
           if (code1  =  0  AND  code2  =  0  AND  count1  =  999999999 
             AND  count2  =  1) then
             EXEC SQL INSERT INTO TESTREPORT
               VALUES('0244','pass','PCO') END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY " *** pass *** "
           else
             EXEC SQL INSERT INTO TESTREPORT
               VALUES('0244','fail','PCO') END-EXEC
             ADD 1 TO errcnt
             MOVE SQLCODE TO SQL-COD
             DISPLAY " dml055.pco *** fail *** "
           END-IF
           DISPLAY "================================================"

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

      ******************** END TEST0244 *******************



      ******************** BEGIN TEST0245 *******************

           DISPLAY " FIPS sizing TEST0245"
           DISPLAY "reference: X3.135-1989 5.5 FIPS PUB 127-1 Section
      -    " 13.5"
           DISPLAY " The precision of DECIMAL is at least 15 digits"
           DISPLAY " - - - - - - - - - - - - - - - - - - -"

           DISPLAY " *** CREATE TABLE PP_15 (NUMTEST
      -    " DECIMAL(15,15)) "
           DISPLAY " INSERT INTO PP_15 "
           DISPLAY " VALUES(.123456789012345);"
           DISPLAY  " "
           DISPLAY " DECLARE DATA9 CURSOR"
           DISPLAY " FOR SELECT NUMTEST"
           DISPLAY " FROM PP_15;"
           DISPLAY " FETCH DATA9 INTO :float1;"
           DISPLAY " INSERT INTO PP_15 "
           DISPLAY " VALUES(-.912345678901234);"
           DISPLAY " FETCH DATA9 INTO :float2;"
           DISPLAY  " "
           DISPLAY "EXEC SQL SELECT COUNT(*) INTO :count1 FROM PP_15"
           DISPLAY " WHERE NUMTEST = -0.912345678901234;"
           DISPLAY  " "
           EXEC SQL DELETE FROM PP_15 END-EXEC
           MOVE SQLCODE TO SQL-COD

           EXEC SQL INSERT INTO PP_15 
             VALUES(.123456789012345) END-EXEC
           MOVE SQLCODE TO SQL-COD

           MOVE SQLCODE TO code1


           EXEC SQL DECLARE DATA9 CURSOR
             FOR SELECT NUMTEST
             FROM   PP_15 END-EXEC
           EXEC SQL OPEN DATA9 END-EXEC
           MOVE SQLCODE TO SQL-COD

           EXEC SQL FETCH DATA9 INTO :float1 END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL CLOSE DATA9 END-EXEC
           MOVE SQLCODE TO SQL-COD

           EXEC SQL DELETE FROM PP_15 END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL INSERT INTO PP_15 
             VALUES(-.912345678901234) END-EXEC
           MOVE SQLCODE TO SQL-COD

           MOVE SQLCODE TO code2

           EXEC SQL OPEN DATA9 END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL FETCH DATA9 INTO :float2 END-EXEC
           MOVE SQLCODE TO SQL-COD
           EXEC SQL CLOSE DATA9 END-EXEC
           MOVE SQLCODE TO SQL-COD

           MOVE 0 TO count1
           EXEC SQL SELECT COUNT(*) INTO :count1 FROM PP_15
             WHERE NUMTEST = -0.912345678901234 END-EXEC
           MOVE SQLCODE TO SQL-COD

           DISPLAY "The correct answer should be:"
           DISPLAY " code1 = 0, code2 = 0 "
           DISPLAY " float1 = 0.123456789012345"
           DISPLAY " float2 = -0.912345678901234"
           DISPLAY " count1 = 1 "

           DISPLAY "Your answer is:"
           DISPLAY " code1 = ", code1 ",code2 = ", code2
           MOVE float1 TO FLOAT-DSP
           DISPLAY " float1 = ", FLOAT-DSP
           MOVE float2 TO FLOAT-DSP
           DISPLAY " float2 = ", FLOAT-DSP
           DISPLAY " count1 = ", count1

           if (float1  >  0.123456789012345) then
             COMPUTE f1 = float1 - 0.123456789012345
           else
             COMPUTE f1 = 0.123456789012345 - float1
           END-IF
           if (float2  >  -0.912345678901234) then
             COMPUTE f2 = float2 + 0.912345678901234
           else
             COMPUTE f2 = -0.912345678901234 - float2
           END-IF
           if (f1  <  0.000000000000005) then
             MOVE 0 TO t1
           else
             MOVE 1 TO t1
           END-IF
           if (f2  <  0.000000000000005) then
             MOVE 0 TO t2
           else
             MOVE 1 TO t2
           END-IF
           EXEC SQL ROLLBACK WORK END-EXEC
           MOVE SQLCODE TO SQL-COD
           if (code1  =  0  AND  code2  =  0  AND  t1  =  0  AND  t2  = 
             0  AND  count1  = 1) then
             EXEC SQL INSERT INTO TESTREPORT
               VALUES('0245','pass','PCO') END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY " *** pass *** "
           else
             EXEC SQL INSERT INTO TESTREPORT
               VALUES('0245','fail','PCO') END-EXEC
             ADD 1 TO errcnt
             MOVE SQLCODE TO SQL-COD
             DISPLAY " dml055.pco *** fail *** "
           END-IF
           DISPLAY "================================================"

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

      ******************** END TEST0245 *******************

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

      *    ****  Procedures for PERFORM statements