Quelle  dml071.cob

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


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


      ****************************************************************
      *                                                              
      *                 COMMENT SECTION                              
      *                                                              
      * DATE 1989/08/21 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.
      *                                                              
      * DML071.PCO                                                    
      * WRITTEN BY: SUN DAJUN                                        
      *                                                              
      *   THIS ROUTINE TESTS THE WHENEVER CONDITIONS.                
      *                                                              
      * REFERENCES                                                   
      *       AMERICAN NATIONAL STANDARD database language - SQL     
      *                         X3.168-1989                          
      *                                                              
      *       SECTION 9.2   <embedded exception declaration>         
      *                                                              
      ****************************************************************



           EXEC SQL BEGIN DECLARE SECTION END-EXEC
       01  EMPNO1 PIC  X(3).
       01  SNUM PIC  X(3).
       01  ind1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  indic1 PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
       01  HOURS1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  i 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  cnt PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  cnt2 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 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, dml071.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 TEST0414 *******************

             MOVE 0 TO ind1
             MOVE 0 TO cnt
             MOVE 0 TO cnt2

             DISPLAY "                   TEST0414          "
             DISPLAY "      WHENEVER NOT FOUND, multiple settings "
             DISPLAY "Reference: ANSI X3.168-1989 Section 9.2 General
      -    " Rules 1) a)"
             DISPLAY "Reference: ANSI X3.135-1989 Section 7.3 General
      -    " Rules 3) a)"
             DISPLAY "   - - - - - - - - - - - - - - - - - - - - - - -"

             DISPLAY "**** If this test lasts too long, stop it and ***"
             DISPLAY "**** the result should be FAIL. ***"

             EXEC SQL WHENEVER NOT FOUND GOTO P100 END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL DECLARE X CURSOR
               FOR SELECT EMPNUM,HOURS
               FROM   WORKS
               WHERE  PNUM='P2'
               ORDER  BY EMPNUM DESC END-EXEC

           .
        P200.
             DISPLAY "At label P200 with cnt=", cnt " and cnt2=", cnt2
             COMPUTE cnt = cnt + 1
             EXEC SQL OPEN X END-EXEC
             MOVE SQLCODE TO SQL-COD
      *Fetch past end of cursor: 
             MOVE 0 TO i
             PERFORM P50 UNTIL i > 19
             COMPUTE ind1 = -1
             DISPLAY "***  should never get here: whenever NOT FOUND
      -    " failed"
             DISPLAY "***  SQLCODE should be 100, it was ", SQL-COD.
             GO TO P100.

        P50.
               EXEC SQL FETCH X INTO :EMPNO1,:HOURS1 END-EXEC
               MOVE SQLCODE TO SQL-COD
               DISPLAY "                EMPNO1=", EMPNO1 " and HOURS1=",
             HOURS1 " "
             ADD 1 TO i
           .

        P100.
             DISPLAY "At label P100 with cnt=", cnt " and cnt2=", cnt2
             EXEC SQL CLOSE X END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (cnt  =  5) then
               GO TO P300
             END-IF
             EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC
             MOVE SQLCODE TO SQL-COD

      *Empty SELECT.  SQLCODE = 100 with no GOTO in effect 
             EXEC SQL SELECT EMPNUM INTO :EMPNO1 FROM STAFF 
               WHERE CITY = 'Kensington' END-EXEC
             MOVE SQLCODE TO SQL-COD

      * Cardinality error.  SQLCODE < 0 with no GOTO in effect 
             EXEC SQL SELECT EMPNUM INTO :EMPNO1 FROM WORKS END-EXEC
             MOVE SQLCODE TO SQL-COD

             EXEC SQL DECLARE LION CURSOR FOR
               SELECT EMPNUM FROM STAFF
               WHERE EMPNUM = 'E20' END-EXEC
             if (cnt2  >  0) then
               EXEC SQL CLOSE LION END-EXEC
               MOVE SQLCODE TO SQL-COD
             END-IF
             EXEC SQL OPEN LION END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL WHENEVER NOT FOUND GO TO P200 END-EXEC
             MOVE SQLCODE TO SQL-COD
             COMPUTE cnt2 = cnt2 + 1
      * FETCH on empty cursor: 
             EXEC SQL FETCH LION INTO :EMPNO1 END-EXEC
             MOVE SQLCODE TO SQL-COD
             COMPUTE ind1 = -1
             DISPLAY "***  should never get here: whenever NOT FOUND
      -    " failed"
             DISPLAY "***  SQLCODE should be 100, it was ", SQL-COD

           .
        P300.
             DISPLAY "At label P300"
             EXEC SQL WHENEVER NOT FOUND GOTO P400 END-EXEC
             MOVE SQLCODE TO SQL-COD
      * Delete searched not found: 
             EXEC SQL DELETE FROM WORKS WHERE HOURS = 77 END-EXEC
             MOVE SQLCODE TO SQL-COD
             COMPUTE ind1 = -1
             DISPLAY "***  SQLCODE should be 100, it was ", SQL-COD
             DISPLAY "***  should never get here: whenever NOT FOUND
      -    " failed"

           .
        P400.
             DISPLAY "At label P400"
             EXEC SQL WHENEVER NOT FOUND GOTO P500 END-EXEC
             MOVE SQLCODE TO SQL-COD
      * Update searched not found: 
             EXEC SQL UPDATE STAFF SET GRADE = 15
               WHERE CITY =
               (SELECT CITY FROM PROJ
               WHERE PNAME = 'SDP' AND PTYPE = 'Test') END-EXEC
             MOVE SQLCODE TO SQL-COD
             COMPUTE ind1 = -1
             DISPLAY "***  should never get here: whenever NOT FOUND
      -    " failed"
             DISPLAY "***  SQLCODE should be 100, it was ", SQL-COD

           .
        P500.
             DISPLAY "At label P500"
             EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL ROLLBACK WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (ind1  =  0  AND  cnt  =  5  AND  cnt2  =  4)   then
               DISPLAY "             *** pass *** "
               EXEC SQL INSERT INTO TESTREPORT
                 VALUES('0414','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY "   dml071.pco  *** fail *** "
               EXEC SQL INSERT INTO TESTREPORT
                 VALUES('0414','fail','PCO') END-EXEC
             ADD 1 TO errcnt
               MOVE SQLCODE TO SQL-COD
             END-IF
             DISPLAY
             "===================================================="
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

      ******************** END TEST0414 *******************


      ******************** BEGIN TEST0415 *******************


             MOVE 0 TO ind1
             MOVE 0 TO cnt
             MOVE 0 TO cnt2
             DISPLAY "                  TEST0415          "
             DISPLAY "      WHENEVER SQLERROR, multiple settings "
             DISPLAY "Reference: ANSI X3.168-1989 Section 9.2 General
      -    " Rules 1) b)"
             DISPLAY "     - - - - - - - - - - - - - - - - - - -"

             DISPLAY "**** If this test lasts too long, stop it and ***"
             DISPLAY "**** the result should be FAIL."

             EXEC SQL WHENEVER SQLERROR GO TO P110 END-EXEC
             MOVE SQLCODE TO SQL-COD

           .
        P130.
             DISPLAY "At label P130"
             COMPUTE cnt = cnt + 1
      *View check constraint error.  Column 3 value less than 12. 
             EXEC SQL INSERT INTO STAFFV2
               VALUES('E20', 'John', 2, 'Potomac') END-EXEC
             MOVE SQLCODE TO SQL-COD
             COMPUTE ind1 = -1
             DISPLAY "***  should never get here: whenever SQLERROR
      -    " failed"
             DISPLAY "***  SQLCODE should be <0, it was ", SQL-COD

           .
        P110.
             DISPLAY "At label P110"
             if (cnt  =  5) then
               GO TO P140
             END-IF
             EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL DELETE FROM PROJ1 END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL INSERT INTO PROJ1
               SELECT * FROM PROJ END-EXEC
             MOVE SQLCODE TO SQL-COD

      *Empty SELECT.  SQLCODE = 100 with no GOTO in effect 
             EXEC SQL SELECT EMPNUM INTO :EMPNO1 FROM STAFF 
               WHERE CITY = 'Kensington' END-EXEC
             MOVE SQLCODE TO SQL-COD

      * Cardinality error.  SQLCODE < 0 with no GOTO in effect 
             EXEC SQL SELECT EMPNUM INTO :EMPNO1 FROM WORKS END-EXEC
             MOVE SQLCODE TO SQL-COD

             EXEC SQL WHENEVER SQLERROR GO TO P130 END-EXEC
             MOVE SQLCODE TO SQL-COD
             COMPUTE cnt2 = cnt2 + 1
      * Uniqueness constraint violation.  Value 'P1' duplicates. 
             EXEC SQL INSERT INTO PROJ1
               VALUES('P1', 'CA', 'Acro', 20, 'Tibet') END-EXEC
             MOVE SQLCODE TO SQL-COD
             COMPUTE ind1 = -1
             DISPLAY "***  should never get here: whenever SQLERROR
      -    " failed"
             DISPLAY "***  SQLCODE should be <0, it was ", SQL-COD

           .
        P140.
             DISPLAY "At label P140"
             EXEC SQL WHENEVER SQLERROR GO TO P120 END-EXEC
             MOVE SQLCODE TO SQL-COD
      * NOT NULL constraint violation in first column 
             COMPUTE indic1 = -1
             EXEC SQL INSERT INTO STAFF1
               VALUES (:EMPNO1 :indic1, 'Ford', 30, 'Tomb') END-EXEC
             MOVE SQLCODE TO SQL-COD
             COMPUTE ind1 = -1
             DISPLAY "***  should never get here: whenever SQLERROR
      -    " failed"
             DISPLAY "***  SQLCODE should be <0, it was ", SQL-COD

           .
        P120.
             DISPLAY "At label P120"
             EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL ROLLBACK WORK END-EXEC
             MOVE SQLCODE TO SQL-COD


             if (cnt  =  5  AND  ind1  =  0  AND  cnt2  =  4) then
               DISPLAY "             *** pass *** "
               EXEC SQL INSERT INTO TESTREPORT 
                 VALUES('0415','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY "   dml071.pco  *** fail *** "
               EXEC SQL INSERT INTO TESTREPORT
                 VALUES('0415','fail','PCO') END-EXEC
             ADD 1 TO errcnt
               MOVE SQLCODE TO SQL-COD
             END-IF
             DISPLAY
             "===================================================="
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

      ******************** END TEST0415 *******************

      ******************** BEGIN TEST0416 *******************

             MOVE 0 TO cnt
             MOVE 0 TO ind1
             DISPLAY "                  TEST0416          "
             DISPLAY "      WHENEVER NOTFOUND overlaps WHENEVER SQLERROR
      -    " "
             DISPLAY "Reference: ANSI X3.168-1989 Section 9.2 General
      -    " Rules 1) c)"
             DISPLAY "     - - - - - - - - - - - - - - - - - - -"

             DISPLAY "**** If this test lasts too long, stop it and the
      -    " result***"
             DISPLAY "**** should be FAIL."

             EXEC SQL DECLARE MONKEY CURSOR
               FOR SELECT EMPNUM,HOURS
               FROM   WORKS
               WHERE  PNUM='P2'
               ORDER  BY EMPNUM DESC END-EXEC
             EXEC SQL WHENEVER SQLERROR GO TO P210 END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL WHENEVER NOT FOUND GOTO P280 END-EXEC
             MOVE SQLCODE TO SQL-COD

           .
        P230.
             DISPLAY "At label P230"
             COMPUTE cnt = cnt + 1
             if (cnt  NOT =  1  AND  cnt  NOT =  3  AND  cnt  NOT =  8)
             then
               COMPUTE ind1 = -1
             END-IF
      *Cardinality error: 
             EXEC SQL SELECT EMPNUM
               INTO   :EMPNO1
               FROM   WORKS
               WHERE  PNUM='P2' END-EXEC
             MOVE SQLCODE TO SQL-COD

             EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC
             MOVE SQLCODE TO SQL-COD

           .
        P240.
             DISPLAY "At label P240"
             COMPUTE cnt = cnt + 1
             if (cnt  NOT =  6) then
               COMPUTE ind1 = -1
             END-IF
             EXEC SQL OPEN MONKEY END-EXEC
             MOVE SQLCODE TO SQL-COD
      * Fetch past end of cursor: 
             MOVE 0 TO i
             PERFORM P49 UNTIL i > 19
             COMPUTE ind1 = -1
             DISPLAY "***  should never get here: whenever SQLERROR
      -    " failed"
             DISPLAY "***  SQLCODE should be <0, it was ", SQL-COD.
             GO TO P210.

        P49.
               EXEC SQL FETCH MONKEY INTO :EMPNO1,:HOURS1 END-EXEC
               MOVE SQLCODE TO SQL-COD
               DISPLAY "                EMPNO1=", EMPNO1 " and HOURS1=",
             HOURS1 " "
             ADD 1 TO i
           .

        P210.
             DISPLAY "At label P210"
             COMPUTE cnt = cnt + 1
             if (cnt  =  4) then
               GO TO P250
             END-IF
             if (cnt  =  9) then
               GO TO P260
             END-IF
             EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL DELETE FROM PROJ1 END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL INSERT INTO PROJ1
               SELECT * FROM PROJ END-EXEC
             MOVE SQLCODE TO SQL-COD

             EXEC SQL WHENEVER SQLERROR GO TO P230 END-EXEC
             MOVE SQLCODE TO SQL-COD
      * Uniqueness constraint violation.  Value 'P1' duplicates. 
             if (cnt  NOT =  2) then
               COMPUTE ind1 = -1
             END-IF
             EXEC SQL INSERT INTO PROJ1
               VALUES('P1', 'CA', 'Acro', 20, 'Tibet') END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC
             MOVE SQLCODE TO SQL-COD

           .
        P250.
             DISPLAY "At label P250"
             COMPUTE cnt = cnt + 1
             if (cnt  NOT =  5) then
               COMPUTE ind1 = -1
             END-IF
             EXEC SQL WHENEVER NOT FOUND GOTO P240 END-EXEC
             MOVE SQLCODE TO SQL-COD
      * Empty SELECT: 
             EXEC SQL SELECT EMPNUM INTO :EMPNO1 FROM STAFF
               WHERE EMPNUM = 'E30' END-EXEC
             MOVE SQLCODE TO SQL-COD

           .
        P280.
             DISPLAY "At label P280"
             COMPUTE cnt = cnt + 1
             if (cnt  NOT =  7) then
               COMPUTE ind1 = -1
             END-IF
             EXEC SQL CLOSE MONKEY END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL WHENEVER NOT FOUND GOTO P230 END-EXEC
             MOVE SQLCODE TO SQL-COD
      * Empty SELECT: 
             EXEC SQL SELECT EMPNUM INTO :EMPNO1 FROM STAFF
               WHERE EMPNUM = 'E30' END-EXEC
             MOVE SQLCODE TO SQL-COD

           .
        P260.
             DISPLAY "At label P260"
             COMPUTE cnt = cnt + 1
             if (cnt  NOT =  10) then
               COMPUTE ind1 = -1
             END-IF
             EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL ROLLBACK WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

             if (ind1  =  0) then
               DISPLAY "             *** pass *** "
               EXEC SQL INSERT INTO TESTREPORT
                 VALUES('0416','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY "   dml071.pco  *** fail *** "
               EXEC SQL INSERT INTO TESTREPORT
                 VALUES('0416','fail','PCO') END-EXEC
             ADD 1 TO errcnt
               MOVE SQLCODE TO SQL-COD
             END-IF
             DISPLAY
             "===================================================="
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

      ******************** END TEST0416 *******************

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

      *    ****  Procedures for PERFORM statements