Quelle  dml034.cob   Sprache: Cobol

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


      * EMBEDDED COBOL (file "DML034.PCO")  

      ****************************************************************
      *                                                              
      *                 COMMENT SECTION                              
      *                                                              
      * DATE 1988/02/10 EMBEDDED 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.
      *                                                              
      * DML034.PCO                                                    
      * WRITTEN BY: HU YANPING                                       
      * TRANSLATED AUTOMATICALLY FROM EMBEDDED C BY CHRIS SCHANZLE
      * REVISED 1989/10/04 BY S. HURWITZ & J. SULLIVAN
      *                                                              
      *    THIS ROUTINE TESTS THE DATA TYPES IN SQL LANGUAGE.        
      *                                                              
      * REFERENCES                                                   
      *       AMERICAN NATIONAL STANDARD database language - SQL     
      *                         X3.135-1989                          
      *                                                              
      *             SECTION 5.5 <data type>                          
      *                                                              
      *             Database Language Embedded SQL             
      *                         X3.168-1989
      *             SECTION 9. <Embedded SQL Host Program>             
      *                                                              
      ****************************************************************



           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  D13P6 PIC S9(7)V9(6) 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  SQL-COD PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  D13P6Q PIC -9(7).9(6) .

      * 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, dml034.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 TEST0088 *******************


           DISPLAY " TEST0088"
           DISPLAY "reference: X3.135-1989 5.5 & X3H2-87-262 9. "
           DISPLAY " - - - - - - - - - - - - - - - - - - -"

           DISPLAY " *** CREATE TABLE GG (realtest REAL) "
           DISPLAY " *** INSERT INTO GG "
           DISPLAY " *** VALUES(123.4567E-2) "
           DISPLAY  " "

           EXEC SQL INSERT INTO GG 
             VALUES(123.4567E-2) END-EXEC
           MOVE SQLCODE TO SQL-COD

           DISPLAY " After INSERT SQLCODE = ", SQL-COD

           MOVE -1 TO count1
           MOVE -1 TO count2
           
           EXEC SQL SELECT COUNT ( * ) INTO :count1 
           FROM GG WHERE REALTEST NOT BETWEEN 1.2345 AND 1.2346 END-EXEC

           EXEC SQL SELECT COUNT ( * ) INTO :count2 
             FROM GG WHERE REALTEST BETWEEN 1.2345 AND 1.2346 END-EXEC

           DISPLAY "count1 = ", count1 " *** count1 should be 0 ***"
           DISPLAY "count2 = ", count2 " *** count2 should be 1 ***"

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

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

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

      ******************** END TEST0088 *******************
      ******************** BEGIN TEST0090 *******************

           DISPLAY " TEST0090"
           DISPLAY "reference: X3.135-1989 5.5 & X3H2-87-262 9. "
           DISPLAY " - - - - - - - - - - - - - - - - - - -"

           DISPLAY " *** CREATE TABLE II (doubletest DOUBLE
      -    " PRECISION) "
           DISPLAY " *** INSERT INTO II "
           DISPLAY " *** VALUES(0.123456123456E6) "
           DISPLAY  " "

           EXEC SQL INSERT INTO II 
             VALUES(0.123456123456E6) END-EXEC
           MOVE SQLCODE TO SQL-COD

           DISPLAY " After INSERT SQLCODE = ", SQL-COD

           MOVE -1 TO count1
           MOVE -2 TO count2

           EXEC SQL SELECT COUNT ( * ) INTO :count1 FROM II WHERE
           DOUBLETEST BETWEEN 123456.1234 AND 123456.1235 END-EXEC

           EXEC SQL SELECT COUNT ( * ) INTO :count2 FROM II WHERE
           DOUBLETEST NOT BETWEEN 123456.1234 AND 123456.1235 END-EXEC
   
           DISPLAY "count1 = ", count1 " *** count1 should be 1 ***"
           DISPLAY "count2 = ", count2 " *** count2 should be 0 ***"

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

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

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

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

      ******************** END TEST0090 *******************
      ******************** BEGIN TEST0091 *******************

           DISPLAY " TEST0091"
           DISPLAY "reference: X3.135-1989 5.5 & X3H2-87-262 9. "
           DISPLAY " - - - - - - - - - - - - - - - - - - -"

           DISPLAY " *** CREATE TABLE JJ (floattest FLOAT) "
           DISPLAY " *** INSERT INTO JJ "
           DISPLAY " *** VALUES(12.345678) "
           DISPLAY  " "

           EXEC SQL INSERT INTO JJ 
             VALUES(12.345678) END-EXEC
           MOVE SQLCODE TO SQL-COD

           DISPLAY " After INSERT SQLCODE = ", SQL-COD

           MOVE -1 TO count1
           MOVE -1 TO count2
          
           EXEC SQL SELECT COUNT ( * ) INTO :count1 FROM JJ
             WHERE FLOATTEST BETWEEN 12.3456 AND 12.3457 END-EXEC

           EXEC SQL SELECT COUNT ( * ) INTO :count2 FROM JJ
             WHERE FLOATTEST NOT BETWEEN 12.3456 AND 12.3457 END-EXEC

           DISPLAY "count1 = ", count1, " *** count1 should be 1 ***"
           DISPLAY "count2 = ", count2, " *** count2 should be 0 ***"

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

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

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

      ******************** END TEST0091 *******************
      ******************** BEGIN TEST0092 *******************

           DISPLAY " TEST0092"
           DISPLAY "reference: X3.135-1989 5.5 & X3H2-87-262 9. "
           DISPLAY " - - - - - - - - - - - - - - - - - - -"

           DISPLAY " *** CREATE TABLE KK (floattest FLOAT(32)) "
           DISPLAY " *** INSERT INTO KK "
           DISPLAY " *** VALUES(123.456123456E+3) "
           DISPLAY  " "

           EXEC SQL INSERT INTO KK 
             VALUES(123.456123456E+3) END-EXEC
           MOVE SQLCODE TO SQL-COD

           DISPLAY " After INSERT SQLCODE = ", SQL-COD

           MOVE -1 TO count1
           MOVE -2 TO count2

           EXEC SQL SELECT COUNT ( * ) INTO :count1 FROM KK
             WHERE FLOATTEST > 123456.1234 END-EXEC

           EXEC SQL SELECT COUNT ( * ) INTO :count2 FROM KK
             WHERE FLOATTEST < 123456.1236 END-EXEC

           DISPLAY "count1 = ", count1 " *** count1 should be 1 ***"
           DISPLAY "count2 = ", count2 " *** count2 should be 1 ***"

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

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

      ******************** END TEST0092 *******************
      ******************** BEGIN TEST0093 *******************

           DISPLAY " TEST0093"
           DISPLAY "reference: X3.135-1989 5.5 & X3H2-87-262 9. "
           DISPLAY " - - - - - - - - - - - - - - - - - - -"

           DISPLAY " *** CREATE TABLE LL (numtest NUMERIC(13,6)) "
           DISPLAY " *** INSERT INTO LL "
           DISPLAY " *** VALUES(123456.123456) "
           DISPLAY  " "

           EXEC SQL INSERT INTO LL 
             VALUES(123456.123456) END-EXEC
           MOVE SQLCODE TO SQL-COD

           DISPLAY " After INSERT SQLCODE = ", SQL-COD " "

           MOVE 0 TO D13P6

           EXEC SQL SELECT * 
             INTO   :D13P6
             FROM   LL END-EXEC
           MOVE SQLCODE TO SQL-COD

           MOVE D13P6 TO D13P6Q
           DISPLAY " D13P6 = ", D13P6Q 
           DISPLAY " *** D13P6 should be 123456.123456 ***"

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

           if ( D13P6 = 123456.123456 ) then
             DISPLAY " *** pass ***"
             EXEC SQL INSERT INTO TESTREPORT
               VALUES('0093','pass','PCO') END-EXEC
             MOVE SQLCODE TO SQL-COD
           else
             DISPLAY " dml034.pco *** fail ***"
             EXEC SQL INSERT INTO TESTREPORT
               VALUES('0093','fail','PCO') END-EXEC
             ADD 1 TO errcnt
             MOVE SQLCODE TO SQL-COD
           END-IF

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

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


      ******************** END TEST0093 *******************
      ******************** BEGIN TEST0094 *******************

           DISPLAY " TEST0094 "
           DISPLAY "reference: X3.135-1989 5.5 & X3H2-87-262 9. "
           DISPLAY " - - - - - - - - - - - - - - - - - - -"

           DISPLAY " *** CREATE TABLE PP (numtest DECIMAL(13,6)) "
           DISPLAY " *** INSERT INTO PP "
           DISPLAY " *** VALUES(123456.123456) "
           DISPLAY  " "

           EXEC SQL INSERT INTO PP 
             VALUES(123456.123456) END-EXEC
           MOVE SQLCODE TO SQL-COD

           DISPLAY " After INSERT SQLCODE = ", SQL-COD

           MOVE 0 TO D13P6

           EXEC SQL SELECT * 
             INTO   :D13P6
             FROM   PP END-EXEC
           MOVE SQLCODE TO SQL-COD
           MOVE D13P6 TO D13P6Q

           DISPLAY " D13P6 = ", D13P6Q
           DISPLAY " *** D13P6 should be 123456.123456 ***"
      
           EXEC SQL ROLLBACK WORK END-EXEC
           MOVE SQLCODE TO SQL-COD

           if ( D13P6 = 123456.123456 ) then
             DISPLAY " *** pass ***"
             EXEC SQL INSERT INTO TESTREPORT
               VALUES('0094','pass','PCO') END-EXEC
             MOVE SQLCODE TO SQL-COD
           else
             DISPLAY " dml034.pco *** fail ***"
             EXEC SQL INSERT INTO TESTREPORT
               VALUES('0094','fail','PCO') END-EXEC
             ADD 1 TO errcnt
             MOVE SQLCODE TO SQL-COD
           END-IF

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


      ******************** END TEST0094 *******************
      ******************** BEGIN TEST0095 *******************

           DISPLAY " TEST0095"
           DISPLAY "reference: X3.135-1989 5.5 & X3H2-87-262 9. "
           DISPLAY " - - - - - - - - - - - - - - - - - - -"

           DISPLAY " *** CREATE TABLE SS (numtest DEC(13,6)) "
           DISPLAY " *** INSERT INTO SS "
           DISPLAY " *** VALUES(123456.123456) "
           DISPLAY  " "

           EXEC SQL INSERT INTO SS 
             VALUES(123456.123456) END-EXEC
           MOVE SQLCODE TO SQL-COD

           DISPLAY " After INSERT SQLCODE = ", SQL-COD

           MOVE 0 TO D13P6

           EXEC SQL SELECT *
             INTO   :D13P6
             FROM   SS END-EXEC
           MOVE SQLCODE TO SQL-COD
           MOVE D13P6 TO D13P6Q

           DISPLAY " D13P6 = ", D13P6Q
           DISPLAY " *** D13P6 should be 123456.123456 ***"

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

           if ( D13P6 = 123456.123456 ) then
             DISPLAY " *** pass ***"
             EXEC SQL INSERT INTO TESTREPORT
               VALUES('0095','pass','PCO') END-EXEC
             MOVE SQLCODE TO SQL-COD
           else
             DISPLAY " dml034.pco *** fail ***"
             EXEC SQL INSERT INTO TESTREPORT
               VALUES('0095','fail','PCO') END-EXEC
             ADD 1 TO errcnt
             MOVE SQLCODE TO SQL-COD
           END-IF

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

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

      ******************** END TEST0095 *******************

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

      *    ****  Procedures for PERFORM statements