Quelle  dml079.cob   Sprache: Cobol

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


      * EMBEDDED COBOL (file "DML079.PCO")  

      ****************************************************************
      *                                                              
      *                 COMMENT SECTION                              
      *                                                              
      * DATE 1991/10/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.
      *                                                              
      * DML079.PCO                                                    
      * WRITTEN BY: SHIRLEY HURWITZ                                       
      *                                                              
      * THIS ROUTINE TESTS MISCELLANEOUS FEATURES.                   
      *                                                              
      * REFERENCES                                                   
      *       AMERICAN NATIONAL STANDARD database language - SQL     
      *                         X3.135-1989                          
      *                         X3.168-1989                          
      *                                                              
      ****************************************************************



           EXEC SQL BEGIN DECLARE SECTION END-EXEC
       01  EMPNM1 PIC  X(20).
       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  count4 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  count5 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  count6 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(9) DISPLAY SIGN LEADING SEPARATE.

      *date_time declaration 
       01  TO-DAY PIC 9(6).
       01  THE-TIME PIC 9(8).

       01  flag1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  flag2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  i PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  ii PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  j PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  jj PIC S9(9) DISPLAY SIGN LEADING SEPARATE.

       01  SQL-COD PIC S9(9) DISPLAY SIGN LEADING SEPARATE.

       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
             MOVE SQLCODE TO SQL-COD
             if (uid  NOT  =   uidx) then
               DISPLAY "ERROR: User ", uid " expected. User ", uidx "
      -    " connected"
             END-IF
             MOVE 0 TO errcnt
           DISPLAY
           "SQL Test Suite, V6.0, Embedded COBOL, dml079.pco"
             DISPLAY 
           "59-byte ID"
           DISPLAY "TEd Version #"

      *date_time print 
           ACCEPT TO-DAY FROM DATE
           ACCEPT THE-TIME FROM TIME
           DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIME

      ******************** BEGIN TEST0451 *******************

             DISPLAY "=============================================="
             DISPLAY " TEST0451 "
             DISPLAY " UNIQUEness is case sensitive "
             DISPLAY "X3.135-1989 Sec. 4.2.1 Character strings "
             DISPLAY "X3.135-1989 Sec. 5.1 Format "
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             MOVE 0 TO i

             EXEC SQL UPDATE STAFF SET EMPNUM = 'e2'
               WHERE EMPNUM = 'E4' END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  =  0) then
               ADD 1 TO i
             END-IF
               DISPLAY " 1. SQLCODE = 0 is a pass. SQLCODE = ", SQL-COD

             EXEC SQL INSERT INTO STAFF(EMPNUM)
               VALUES ('E1') END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  <  0) then
               ADD 1 TO i
             END-IF
               DISPLAY " 2. SQLCODE less than 0 is a pass. SQLCODE = ",
               SQL-COD

             EXEC SQL INSERT INTO STAFF(EMPNUM)
               VALUES ('e1') END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  =  0) then
               ADD 1 TO i
             END-IF
               DISPLAY " 3. SQLCODE = 0 is a pass. SQLCODE = ", SQL-COD
  
             EXEC SQL UPDATE STAFF
               SET EMPNUM = 'E1' WHERE EMPNUM = 'e1' END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  <  0) then
               ADD 1 TO i
             END-IF
               DISPLAY " 4. SQLCODE less than 0 is a pass. SQLCODE = ",
               SQL-COD

             EXEC SQL INSERT INTO WORKS (EMPNUM,PNUM)
               VALUES ('e1','p2') END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  =  0) then
               ADD 1 TO i
             END-IF
               DISPLAY " 5. SQLCODE = 0 is a pass. SQLCODE = ", SQL-COD

             EXEC SQL INSERT INTO WORKS (EMPNUM,PNUM)
               VALUES ('E1','p2') END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  =  0) then
               ADD 1 TO i
             END-IF
               DISPLAY " 6. SQLCODE = 0 is a pass. SQLCODE = ", SQL-COD

             EXEC SQL INSERT INTO WORKS (EMPNUM,PNUM) 
               VALUES ('E1','P2') END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  <  0) then
               ADD 1 TO i
             END-IF
               DISPLAY " 7. SQLCODE less than 0 is a pass. SQLCODE = ",
               SQL-COD

             EXEC SQL INSERT INTO WORKS (EMPNUM,PNUM)
               VALUES ('e1', 'P2') END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  =  0) then
               ADD 1 TO i
               END-IF
               DISPLAY " 8. SQLCODE = 0 is a pass. SQLCODE = ", SQL-COD

             EXEC SQL UPDATE WORKS
               SET EMPNUM = 'E1'
               WHERE PNUM = 'P5' AND EMPNUM = 'E4' END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  <  0) then
               ADD 1 TO i
             END-IF
               DISPLAY " 9. SQLCODE less than 0 is a pass. SQLCODE = ",
               SQL-COD

             EXEC SQL UPDATE WORKS
               SET EMPNUM = 'e1'
               WHERE PNUM = 'P5' AND EMPNUM = 'E4' END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  =  0) then
               ADD 1 TO i
             END-IF
               DISPLAY " 10. SQLCODE = 0 is a pass. SQLCODE = ",
               SQL-COD

             EXEC SQL UPDATE WORKS
               SET PNUM = 'P4'
               WHERE PNUM = 'P2' AND EMPNUM = 'E4' END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  <  0) then
               ADD 1 TO i
             END-IF
               DISPLAY " 11. SQLCODE less than 0 is a pass. SQLCODE =
      -    " ", SQL-COD

             EXEC SQL UPDATE WORKS
               SET PNUM = 'p4'
               WHERE PNUM = 'P2' AND EMPNUM = 'E4' END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  =  0) then
               ADD 1 TO i
             END-IF
               DISPLAY " 12. SQLCODE = 0 is a pass. SQLCODE = ",
               SQL-COD

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

             DISPLAY " The correct answer is i = 12"
             DISPLAY " Your answer is i = ", i

             if (i  =  12) then
               DISPLAY " *** pass ***"
               EXEC SQL INSERT INTO TESTREPORT
                 VALUES('0451','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml079.pco *** fail ***"
               EXEC SQL INSERT INTO TESTREPORT
                 VALUES('0451','fail','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
             END-IF

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

      ******************** END TEST0451 *******************

      ******************** BEGIN TEST0452 *******************

             MOVE  0 TO i
             MOVE  0 TO j

             DISPLAY " TEST0452 "
             DISPLAY " Order of precedence, Left to Right, in UNION
      -    " (ALL) "
             DISPLAY "X3.135-1989 sec. 8.3 GR 2) b) and
      -    " "
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             DISPLAY " *** FOR (SELECT EMPNAME FROM STAFF )"
             DISPLAY " *** UNION "
             DISPLAY " *** SELECT EMPNAME FROM STAFF "
             DISPLAY " *** UNION ALL "
             DISPLAY " *** SELECT EMPNAME FROM STAFF"

             DISPLAY " *** FOR (SELECT EMPNAME FROM STAFF )"
             DISPLAY " *** UNION ALL "
             DISPLAY " *** SELECT EMPNAME FROM STAFF "
             DISPLAY " *** UNION "
             DISPLAY " *** SELECT EMPNAME FROM STAFF"

             EXEC SQL DECLARE X1 CURSOR
               FOR SELECT EMPNAME FROM STAFF
               UNION
               SELECT EMPNAME FROM STAFF
               UNION ALL 
               SELECT EMPNAME FROM STAFF END-EXEC

             EXEC SQL DECLARE X2 CURSOR
               FOR SELECT EMPNAME FROM STAFF
               UNION ALL
               SELECT EMPNAME FROM STAFF
               UNION
               SELECT EMPNAME FROM STAFF END-EXEC

             EXEC SQL OPEN X1 END-EXEC
             MOVE SQLCODE TO SQL-COD

             MOVE 1 TO ii
             PERFORM P50 UNTIL ii > 15

             EXEC SQL CLOSE X1 END-EXEC
             MOVE SQLCODE TO SQL-COD

             EXEC SQL OPEN X2 END-EXEC
             MOVE SQLCODE TO SQL-COD

             MOVE 1 TO jj
             PERFORM P49 UNTIL jj > 15

             EXEC SQL CLOSE X2 END-EXEC
             MOVE SQLCODE TO SQL-COD

             DISPLAY "The correct answer is i=10 and j=5 "
             DISPLAY "Your answer is i=", i " j=", j " "
             if ((i  =  10)  AND  (j  =  5)) then
               DISPLAY " *** pass ***"
               EXEC SQL INSERT INTO TESTREPORT
                 VALUES('0452','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml079.pco *** fail ***"
               EXEC SQL INSERT INTO TESTREPORT
                 VALUES('0452','fail','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
             END-IF

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

      ******************** END TEST0452 *******************

      ******************** BEGIN TEST0453 *******************

             DISPLAY " TEST0453 "
             DISPLAY " NULL with empty subquery in ALL, SOME, ANY"
             DISPLAY " ref. X3.135-1989 5.16, GR 2a and 2d empty
      -    " subquery "
             DISPLAY
             "--------------------------------------------------------"

             COMPUTE count1 = -7
             COMPUTE count2 = -7
             COMPUTE count3 = -7
             COMPUTE count4 = -7
             COMPUTE count5 = -7
             COMPUTE count6 = -7
             MOVE 0 TO flag1
             MOVE 0 TO flag2

             EXEC SQL UPDATE PROJ
               SET CITY = NULL WHERE PNAME = 'IRM' END-EXEC
             MOVE SQLCODE TO SQL-COD

             EXEC SQL SELECT COUNT(*) INTO :count1 
               FROM PROJ
               WHERE CITY IS NULL END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (count1  NOT =  1) then
               MOVE 1 TO flag1
               DISPLAY "Failed to set city to NULL for IRM "
             END-IF

             EXEC SQL SELECT COUNT(*) INTO :count1
               FROM PROJ
               WHERE CITY = ALL (SELECT CITY
               FROM STAFF
               WHERE EMPNUM = 'E8') END-EXEC
             MOVE SQLCODE TO SQL-COD

             EXEC SQL SELECT COUNT(*) INTO :count2
               FROM PROJ
               WHERE CITY <> ALL (SELECT CITY
               FROM STAFF
               WHERE EMPNUM = 'E8') END-EXEC
             MOVE SQLCODE TO SQL-COD

             EXEC SQL SELECT COUNT(*) INTO :count3
               FROM PROJ
               WHERE CITY = ANY (SELECT CITY
               FROM STAFF
               WHERE EMPNUM = 'E8') END-EXEC
             MOVE SQLCODE TO SQL-COD

             EXEC SQL SELECT COUNT(*) INTO :count4
               FROM PROJ
               WHERE CITY <> ANY (SELECT CITY
               FROM STAFF
               WHERE EMPNUM = 'E8') END-EXEC
             MOVE SQLCODE TO SQL-COD

             EXEC SQL SELECT COUNT(*) INTO :count5
               FROM PROJ
               WHERE CITY = SOME (SELECT CITY
               FROM STAFF
               WHERE EMPNUM = 'E8') END-EXEC
             MOVE SQLCODE TO SQL-COD

             EXEC SQL SELECT COUNT(*) INTO :count6
               FROM PROJ
               WHERE CITY <> SOME (SELECT CITY
               FROM STAFF
               WHERE EMPNUM = 'E8') END-EXEC
             MOVE SQLCODE TO SQL-COD

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


             DISPLAY " The correct answers are:"
             DISPLAY " count1 = 6, count2 = 6, count3 = 0"
             DISPLAY " count4 = 0, count5 = 0, count6 = 0"
             DISPLAY  " "
             DISPLAY " Your answers are:"
             DISPLAY " count1 = ", count1 ", count2 = ", count2 ",
      -    " count3 = ", count3
             DISPLAY " count4 = ", count4 ", count5 = ", count5 ",
      -    " count6 = ", count6

             if ((count1  NOT =  6)  OR  (count2  NOT =  6)  OR  (count3
              NOT =  0)) then
               MOVE 1 TO flag1
             END-IF

             if ((count4  NOT =  0)  OR  (count5  NOT =  0)  OR  (count6
              NOT =  0)) then
               MOVE 1 TO flag2
             END-IF

             if ((flag1  =  0)  AND  (flag2  =  0)) then
               DISPLAY " *** pass *** "
               EXEC SQL INSERT INTO TESTREPORT
                 VALUES('0453','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml079.pco *** fail *** "
               EXEC SQL INSERT INTO TESTREPORT
                 VALUES('0453','fail','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
             END-IF
             DISPLAY  " "
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY
             "=================================================="

      ******************** END TEST0453 *******************

      **** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0

           STOP RUN.

      *    ****  Procedures for PERFORM statements

        P50.
               EXEC SQL FETCH X1 INTO :EMPNM1 END-EXEC
               MOVE SQLCODE TO SQL-COD
               if (SQLCODE  =  0) then
                 MOVE  ii TO i
               END-IF
             ADD 1 TO ii
           .

        P49.
               EXEC SQL FETCH X2 INTO :EMPNM1 END-EXEC
               MOVE SQLCODE TO SQL-COD
               if (SQLCODE  =  0) then
                 MOVE  jj TO j
               END-IF
             ADD 1 TO jj
           .