Quelle  dml077.cob   Sprache: Cobol

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


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

      * STANDARD COBOL (file "DML077.SCO")  

      ****************************************************************
      *                                                              
      *                 COMMENT SECTION                              
      *                                                              
      * DATE 1991/07/30 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.
      *                                                              
      * DML077.SCO                                                    
      * WRITTEN BY: YOLANDA HERD                                     
      *                                                              
      *                                                              
      * REFERENCES                                                   
      *       AMERICAN NATIONAL STANDARD database language           
      *       X3.135-1989                                            
      *                                                              
      *                                                              
      ****************************************************************



      * EXEC SQL BEGIN DECLARE SECTION END-EXEC
       01  GRDE PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  count1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  count2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  count3 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  HRS PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  NUM PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  INT1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  INT2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  indic1 PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
       01  ENUM PIC  X(3).
       01  EMPNO1 PIC  X(3).
       01  PNO1 PIC  X(3).
       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  i PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  flag1 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 "HU" TO uid
             CALL "AUTHID" USING uid
           MOVE "not logged in, not" TO uidx
      * EXEC SQL SELECT 
      *      USER INTO :uidx FROM HU.ECCO;
           CALL "SUB1" USING SQLCODE uidx
           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, dml077.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 TEST0443 *******************
             DISPLAY " TEST0443 "
             DISPLAY " VIEW with check option rejects unknown (NULL)"
             DISPLAY " Reference 6.9 GR 3a, 4.5 para 6 "
             DISPLAY " - - - - - - - - - - - - - - - - - - - -"


      *  EXEC SQL INSERT INTO TEMP_SS VALUES('E7',NULL,'Frankfurt')
      * ;
             CALL "SUB2" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE after NULL literal INSERT = ", SQL-COD

             MOVE 15 TO GRDE
             COMPUTE indic1 = -1

      *  EXEC SQL INSERT INTO TEMP_SS
      *  VALUES('E8',:GRDE:indic1,'Atlanta');
             CALL "SUB3" USING SQLCODE GRDE indic1
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE after NULL with indic INSERT = ", SQL-COD

      *  EXEC SQL INSERT INTO TEMP_SS(EMPNUM) VALUES('E9');
             CALL "SUB4" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE after NULL INSERT by excluding column = ",
             SQL-COD


      *  EXEC SQL UPDATE WORKS 
      *    SET HOURS = NULL 
      *    WHERE PNUM = 'P2';
             CALL "SUB5" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE after UPDATE WORKS 'P2' = ", SQL-COD

      *  EXEC SQL INSERT INTO TEMP_SS 
      *    SELECT PNUM,HOURS,'Nowhere'  
      *    FROM WORKS 
      *    WHERE EMPNUM = 'E1';
             CALL "SUB6" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE after INSERT SELECT 'E1' = ", SQL-COD

      *  EXEC SQL UPDATE TEMP_SS 
      *    SET GRADE = NULL 
      *    WHERE EMPNUM = 'E3';
             CALL "SUB7" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE after UPDATE TEMP_SS 'E3' = ", SQL-COD

      *  EXEC SQL UPDATE TEMP_SS 
      *    SET GRADE = :GRDE:indic1 
      *    WHERE EMPNUM = 'E5';
             CALL "SUB8" USING SQLCODE GRDE indic1
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE after UPDATE TEMP_SS with indic = ",
             SQL-COD

             COMPUTE count1 = -1
             COMPUTE count2 = -1
             COMPUTE count3 = -1

      *  EXEC SQL SELECT COUNT(*) INTO :count1 
      *    FROM STAFF 
      *    WHERE GRADE IS NULL;
             CALL "SUB9" USING SQLCODE count1
             MOVE SQLCODE TO SQL-COD

      *  EXEC SQL SELECT COUNT(*) INTO :count2 
      *    FROM TEMP_SS;
             CALL "SUB10" USING SQLCODE count2
             MOVE SQLCODE TO SQL-COD

      *  EXEC SQL SELECT COUNT(*) INTO :count3 
      *    FROM STAFF;
             CALL "SUB11" USING SQLCODE count3
             MOVE SQLCODE TO SQL-COD

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

             DISPLAY  " "
             DISPLAY " The correct answers are:"
             DISPLAY " count1 = 0, count2 = 2 and count3 = 5"
             DISPLAY  " "
             DISPLAY " Your answers are:"
             DISPLAY " count1 = ", count1 ", count2 = ", count2 " and
      -    " count3 = ", count3


             if (count1  =  0  AND  count2  =  2  AND  count3  =  5) 
             then
      *    EXEC SQL INSERT INTO TESTREPORT 
      *      VALUES('0443','pass','MCO');
               CALL "SUB13" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
               DISPLAY " *** pass *** "
             else
      *    EXEC SQL INSERT INTO TESTREPORT 
      *      VALUES('0443','fail','MCO');
               CALL "SUB14" USING SQLCODE
             ADD 1 TO errcnt
               MOVE SQLCODE TO SQL-COD
               DISPLAY " dml077.sco *** fail *** "
             END-IF
             DISPLAY "================================================"

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

      ******************** END TEST0443 *******************

      ******************** BEGIN TEST0444 *******************


             DISPLAY " TEST0444 "
             DISPLAY " Updatable cursor, modify value selected on"
             DISPLAY " reference X3.135-1989 "
             DISPLAY " ---------------------------------------------"


             MOVE "E1" TO ENUM
             MOVE "XX" TO EMPNO1

      *  EXEC SQL DECLARE Y CURSOR FOR 
      *    SELECT EMPNUM 
      *    FROM STAFF 
      *    WHERE EMPNUM > 'E1' END-EXEC

      *  EXEC SQL DECLARE X CURSOR FOR 
      *    SELECT EMPNUM 
      *    FROM WORKS 
      *    WHERE EMPNUM > :ENUM END-EXEC

      *  EXEC SQL OPEN X;
             CALL "SUB16" USING SQLCODE ENUM
             MOVE SQLCODE TO SQL-COD

             MOVE 1 TO i
             PERFORM P50 UNTIL i > 7

      *  EXEC SQL CLOSE X;
             CALL "SUB17" USING SQLCODE
             MOVE SQLCODE TO SQL-COD

             MOVE "XX" TO EMPNO1

      *  EXEC SQL OPEN Y;
             CALL "SUB18" USING SQLCODE
             MOVE SQLCODE TO SQL-COD

             MOVE 1 TO i
             PERFORM P49 UNTIL i > 5

             COMPUTE count1 = -1
             COMPUTE count2 = -1

      *  EXEC SQL SELECT COUNT(*) INTO :count1 
      *    FROM WORKS 
      *    WHERE EMPNUM > 'E5';
             CALL "SUB19" USING SQLCODE count1
             MOVE SQLCODE TO SQL-COD

      *  EXEC SQL SELECT COUNT(*) INTO :count2 
      *    FROM STAFF 
      *    WHERE EMPNUM > 'E5';
             CALL "SUB20" USING SQLCODE count2
             MOVE SQLCODE TO SQL-COD

             DISPLAY  " "
             DISPLAY " The correct answers are:"
             DISPLAY " count1 = 6 and count2 = 4"
             DISPLAY  " "
             DISPLAY " Your answers are:"
             DISPLAY " count1 = ", count1 " and count2 = ", count2

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

             if (count1  =  6  AND  count2  =  4)  then
      *    EXEC SQL INSERT INTO TESTREPORT 
      *      VALUES('0444','pass','MCO');
               CALL "SUB22" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
               DISPLAY " *** pass *** "
             else
      *    EXEC SQL INSERT INTO TESTREPORT 
      *      VALUES('0444','fail','MCO');
               CALL "SUB23" USING SQLCODE
             ADD 1 TO errcnt
               MOVE SQLCODE TO SQL-COD
               DISPLAY " dml077.sco *** fail *** "
             END-IF
             DISPLAY "================================================"

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

      ******************** END TEST0444 *******************



      ******************** BEGIN TEST0445 *******************
             DISPLAY " TEST0445 "
             DISPLAY " Values not assigned to targets for SQLCODE=100 "
             DISPLAY " reference X3.135-1989"
             DISPLAY "
      -    " ----------------------------------------------------"

             MOVE 0 TO flag1
             MOVE "ZZZ" TO PNO1

      *  EXEC SQL SELECT PNUM INTO :PNO1
      *    FROM WORKS
      *    WHERE HOURS = 13;
             CALL "SUB25" USING SQLCODE PNO1
             MOVE SQLCODE TO SQL-COD
             DISPLAY "PNO1 = ", PNO1 ", SQLCODE after SELECT PNUM = ",
             SQL-COD
             DISPLAY  " "

             if (SQLCODE  NOT =  100  OR  PNO1  NOT =  "ZZZ") then
               MOVE 1 TO flag1
             END-IF

             MOVE 99 TO HRS

      *  EXEC SQL SELECT HOURS INTO :HRS
      *    FROM WORKS
      *    WHERE EMPNUM = 'E4' AND PNUM = 'P1';
             CALL "SUB26" USING SQLCODE HRS
             MOVE SQLCODE TO SQL-COD
             DISPLAY "HRS = ", HRS ", SQLCODE after SELECT HOURS = ",
             SQL-COD
             DISPLAY  " "

             if (SQLCODE  NOT =  100  OR  HRS  NOT =  99) then
               MOVE 1 TO flag1
             END-IF

             MOVE 999 TO NUM

      *  EXEC SQL SELECT COL1 INTO :NUM
      *    FROM VTABLE
      *    WHERE COL2 > 500;
             CALL "SUB27" USING SQLCODE NUM
             MOVE SQLCODE TO SQL-COD
             DISPLAY "NUM = ", NUM ", SQLCODE after SELECT COL1 = ",
             SQL-COD

             if (SQLCODE  NOT =  100  OR  NUM  NOT =  999) then
               MOVE 1 TO flag1
             END-IF

      *  EXEC SQL DECLARE XX CURSOR FOR
      *    SELECT PNUM,HOURS
      *    FROM WORKS
      *    WHERE EMPNUM > 'E1' END-EXEC

      *  EXEC SQL DECLARE YY CURSOR FOR
      *    SELECT COL2, COL3
      *    FROM VTABLE END-EXEC

             MOVE 0 TO count1
             MOVE 0 TO count2

             MOVE "YY" TO PNO1
             MOVE 99 TO HRS
             MOVE 99 TO INT1
             MOVE 99 TO INT2

      *  EXEC SQL OPEN XX;
             CALL "SUB28" USING SQLCODE
             MOVE SQLCODE TO SQL-COD

             MOVE 1 TO i
             PERFORM P48 UNTIL i > 14

      *  EXEC SQL CLOSE XX;
             CALL "SUB29" USING SQLCODE
             MOVE SQLCODE TO SQL-COD

      *  EXEC SQL OPEN YY;
             CALL "SUB30" USING SQLCODE
             MOVE SQLCODE TO SQL-COD

             MOVE 1 TO i
             PERFORM P47 UNTIL i > 9

      *  EXEC SQL CLOSE YY;
             CALL "SUB31" USING SQLCODE
             MOVE SQLCODE TO SQL-COD

             DISPLAY  " "
             DISPLAY "The correct answers are:"
             DISPLAY " count1 = 6, count2 = 4 and flag1 = 0"
             DISPLAY  " "
             DISPLAY "Your answers are:"
             DISPLAY " count1 = ", count1 ", count2 = ", count2 " and
      -    " flag1 = ", flag1

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

             if (count1  =  6  AND  count2  =  4  AND  flag1  =  0) 
             then
      *    EXEC SQL INSERT INTO TESTREPORT 
      *      VALUES('0445','pass','MCO');
               CALL "SUB33" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
               DISPLAY " *** pass *** "
             else
      *    EXEC SQL INSERT INTO TESTREPORT 
      *      VALUES('0445','fail','MCO');
               CALL "SUB34" USING SQLCODE
             ADD 1 TO errcnt
               MOVE SQLCODE TO SQL-COD
               DISPLAY " dml077.sco *** fail *** "
             END-IF
             DISPLAY "================================================"

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

      ******************** END TEST0445 *******************

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

      *    ****  Procedures for PERFORM statements

        P50.
      *    EXEC SQL FETCH X INTO :EMPNO1;
               CALL "SUB36" USING SQLCODE EMPNO1
               MOVE SQLCODE TO SQL-COD

               if (EMPNO1   =   "E2")  then
                 MOVE "E9" TO EMPNO1
               END-IF

               if (EMPNO1   =   "E3")  then
                 MOVE "E7" TO EMPNO1
               END-IF

               if (EMPNO1   =   "E4")  then
                 MOVE "E6" TO EMPNO1
               END-IF

      *    EXEC SQL UPDATE WORKS 
      *      SET EMPNUM = :EMPNO1 
      *      WHERE CURRENT OF X;
               CALL "SUB37" USING SQLCODE EMPNO1
               MOVE SQLCODE TO SQL-COD
             ADD 1 TO i
           .

        P49.
      *    EXEC SQL FETCH Y INTO :EMPNO1;
               CALL "SUB38" USING SQLCODE EMPNO1
               MOVE SQLCODE TO SQL-COD

               if (EMPNO1   =   "E2")  then
                 MOVE "E9" TO EMPNO1
               END-IF

               if (EMPNO1   =   "E3")  then
                 MOVE "E7" TO EMPNO1
               END-IF

               if (EMPNO1   =   "E4")  then
                 MOVE "E6" TO EMPNO1
               END-IF

               if (EMPNO1   =   "E5")  then
                 MOVE "E8" TO EMPNO1
               END-IF

      *    EXEC SQL UPDATE STAFF 
      *      SET EMPNUM = :EMPNO1 
      *      WHERE CURRENT OF Y;
               CALL "SUB39" USING SQLCODE EMPNO1
               MOVE SQLCODE TO SQL-COD
             ADD 1 TO i
           .

        P48.
      *    EXEC SQL FETCH XX INTO :PNO1, :HRS;
               CALL "SUB40" USING SQLCODE PNO1 HRS
               MOVE SQLCODE TO SQL-COD

               if (SQLCODE  =  0) then
                 COMPUTE count1 = count1 + 1
               END-IF
             ADD 1 TO i
           .

        P47.
      *    EXEC SQL FETCH YY INTO :INT1, :INT2;
               CALL "SUB41" USING SQLCODE INT1 INT2
               MOVE SQLCODE TO SQL-COD

               if (SQLCODE  =  0) then
                 COMPUTE count2 = count2 + 1
               END-IF
             ADD 1 TO i
           .