Impressum dml034.cob  Sprache: unbekannt

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


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

      ****************************************************************
      *                                                              
      *                 COMMENT SECTION                              
      *                                                              
      * DATE 1988/02/10 STANDARD 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.
      *                                                              
      * DML034.SCO                                                    
      * WRITTEN BY: HU YANPING                                       
      * TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL 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.
      * EXEC SQL END DECLARE SECTION END-EXEC
       01  uid PIC  X(18).
       01  uidx PIC X(18).

       01  SQL-COD PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  SQLCODE PIC S9(9) COMP.
       01  errcnt PIC S9(4) 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
           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, dml034.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 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
           CALL "SUB1" USING SQLCODE
           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
           CALL "SUB2" USING SQLCODE count1

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

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

      * EXEC SQL ROLLBACK WORK;
           CALL "SUB4" USING SQLCODE
           MOVE SQLCODE TO SQL-COD
           if ( count1 = 0 AND count2 = 1 ) then
             DISPLAY "               *** pass ***"
      *  EXEC SQL INSERT INTO TESTREPORT
      *    VALUES('0088','pass','MCO') END-EXEC
             CALL "SUB5" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
           else
             DISPLAY "     dml034.sco  *** fail ***"
      *  EXEC SQL INSERT INTO TESTREPORT
      *    VALUES('0088','fail','MCO') END-EXEC
             ADD 1 TO errcnt
             CALL "SUB6" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
           END-IF

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

      * EXEC SQL COMMIT WORK;
           CALL "SUB7" USING SQLCODE
           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
           CALL "SUB8" USING SQLCODE
           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
           CALL "SUB9" USING SQLCODE count1

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

      * EXEC SQL ROLLBACK WORK;
           CALL "SUB11" USING SQLCODE
           MOVE SQLCODE TO SQL-COD

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

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

      * EXEC SQL COMMIT WORK;
           CALL "SUB14" USING SQLCODE
           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
           CALL "SUB15" USING SQLCODE
           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
           CALL "SUB16" USING SQLCODE count1

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

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

      * EXEC SQL ROLLBACK WORK;
           CALL "SUB18" USING SQLCODE
           MOVE SQLCODE TO SQL-COD
 
           if ( count1 = 1 AND count2 = 0 ) then
        
             DISPLAY "               *** pass ***"
      *  EXEC SQL INSERT INTO TESTREPORT
      *    VALUES('0091','pass','MCO') END-EXEC
             CALL "SUB19" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
           else
             DISPLAY "     dml034.sco  *** fail ***"
      *  EXEC SQL INSERT INTO TESTREPORT
      *    VALUES('0091','fail','MCO') END-EXEC
             ADD 1 TO errcnt
             CALL "SUB20" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
           END-IF

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

      * EXEC SQL COMMIT WORK;
           CALL "SUB21" USING SQLCODE
           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
           CALL "SUB22" USING SQLCODE
           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
           CALL "SUB23" USING SQLCODE count1

      * EXEC SQL SELECT COUNT ( * ) INTO :count2 FROM KK
      *  WHERE FLOATTEST < 123456.1236 END-EXEC
           CALL "SUB24" USING SQLCODE count2

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

      * EXEC SQL ROLLBACK WORK;
           CALL "SUB25" USING SQLCODE
           MOVE SQLCODE TO SQL-COD
 
           if ( count1 = 1 AND  count2 = 1 ) then
             DISPLAY "               *** pass ***"
      *  EXEC SQL INSERT INTO TESTREPORT
      *    VALUES('0092','pass','MCO') END-EXEC
             CALL "SUB26" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
           else
             DISPLAY "     dml034.sco  *** fail ***"
      *  EXEC SQL INSERT INTO TESTREPORT
      *    VALUES('0092','fail','MCO') END-EXEC
             ADD 1 TO errcnt
             CALL "SUB27" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
           END-IF

           DISPLAY
             "====================================================="
           DISPLAY  " "
      * EXEC SQL COMMIT WORK;
           CALL "SUB28" USING SQLCODE
           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
           CALL "SUB29" USING SQLCODE
           MOVE SQLCODE TO SQL-COD

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

           MOVE 0 TO D13P6

      * EXEC SQL SELECT * 
      *  INTO   :D13P6
      *  FROM   LL END-EXEC
           CALL "SUB30" USING SQLCODE D13P6
           MOVE SQLCODE TO SQL-COD

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

      * EXEC SQL ROLLBACK WORK;
           CALL "SUB31" USING SQLCODE
           MOVE SQLCODE TO SQL-COD

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

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

      * EXEC SQL COMMIT WORK;
           CALL "SUB34" USING SQLCODE
           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
           CALL "SUB35" USING SQLCODE
           MOVE SQLCODE TO SQL-COD

           DISPLAY "  After INSERT SQLCODE = ", SQL-COD

           MOVE 0 TO D13P6

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

           DISPLAY "     D13P6 = ", D13P6Q
           DISPLAY "     *** D13P6 should be 123456.123456 ***"
      
      * EXEC SQL ROLLBACK WORK;
           CALL "SUB37" USING SQLCODE
           MOVE SQLCODE TO SQL-COD

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

           DISPLAY
             "====================================================="
           DISPLAY  " "
      * EXEC SQL COMMIT WORK;
           CALL "SUB40" USING SQLCODE
           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
           CALL "SUB41" USING SQLCODE
           MOVE SQLCODE TO SQL-COD

           DISPLAY "  After INSERT SQLCODE = ", SQL-COD

           MOVE 0 TO D13P6

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

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

      * EXEC SQL ROLLBACK WORK;
           CALL "SUB43" USING SQLCODE
           MOVE SQLCODE TO SQL-COD

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

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

      * EXEC SQL COMMIT WORK;
           CALL "SUB46" USING SQLCODE
           MOVE SQLCODE TO SQL-COD

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

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

      *    ****  Procedures for PERFORM statements