Quelle dml081.cob Sprache: Cobol

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

      * EMBEDDED COBOL (file "DML081.PCO")

      ****************************************************************
      *
      *                 COMMENT SECTION
      *
      * DATE 1992/07/06 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.
      *
      * DML081.PCO
      * WRITTEN BY: DAVID W. FLATER
      *
      *   THIS ROUTINE TESTS THE SQLSTATE STATUS CODE.
      *
      * REFERENCES
      *   ANSI SQL-1992
      *     22.1  SQLSTATE
      *
      ****************************************************************

           EXEC SQL BEGIN DECLARE SECTION END-EXEC
       01  uid PIC  X(18).
       01  uidx PIC  X(18).
       01  tmpcnt PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  xgrade PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  zeero PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  SQLCODE PIC S9(9) COMP.
       01  SQLSTATE PIC  X(5).
             EXEC SQL END DECLARE SECTION END-EXEC

       01  ii PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  norm1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  norm2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  ALPNUM-TABLE VALUE IS
               "01234ABCDEFGH56789IJKLMNOPQRSTUVWXYZ".
           05  ALPNUM PIC X OCCURS 36 TIMES.

       01  NR-TAB.
           05  NORMSQ PIC X OCCURS 5 TIMES.
       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  flag PIC S9(9) DISPLAY SIGN LEADING SEPARATE.

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

       PROCEDURE DIVISION.
       P0.

             MOVE "SCHANZLE" 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"
             STOP RUN
             END-IF
             MOVE 0 TO errcnt
             MOVE 1 TO flag
           DISPLAY
              "SQL Test Suite, V6.0, Embedded COBOL, dml081.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 TEST0487 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0487 "
             DISPLAY "SQLSTATE = 00000: successful completion"
             DISPLAY "Note: VALID implementation-defined subclass will
      -    " be"
             DISPLAY " accepted instead of no-subclass value of 000
      -    " "
             DISPLAY "SQLSTATE = 01xxx will also be accepted, provided "
             DISPLAY " xxx is a valid implementation-defined subclass
      -    " value "
             DISPLAY "Reference ANSI SQL-1992 section 22.1 SQLSTATE"
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             COMPUTE SQLCODE = -55
             MOVE "x" TO SQLSTATE
             DISPLAY "SELECT COUNT (*) FROM HU.WORKS;"
             EXEC SQL SELECT COUNT (*) INTO :tmpcnt FROM HU.WORKS
             END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 00000; its value is ", SQLSTATE

             PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE  NOT = 0 OR NR-TAB NOT = "00000"  OR
             tmpcnt  NOT =  12) then
               MOVE 0 TO flag
             END-IF

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0487','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml081.pco *** fail *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0487','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
      ******************** END TEST0487 ********************

      ******************** BEGIN TEST0488 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0488 "
             DISPLAY "SQLSTATE = 21000: cardinality violation"
             DISPLAY "Note: VALID implementation-defined subclass will
      -    " be"
             DISPLAY " accepted instead of no-subclass value of 000
      -    " "
             DISPLAY "Reference ANSI SQL-1992 section 22.1 SQLSTATE"
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

      *7.11 <scalar subquery> GR1
             MOVE 33 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY "SELECT COUNT(*) INTO :tmpcnt FROM HU.WORKS"
             DISPLAY "WHERE PNUM = (SELECT PNUM FROM HU.WORKS WHERE
      -    " HOURS = 80);"
             EXEC SQL SELECT COUNT(*) INTO :tmpcnt FROM HU.WORKS
               WHERE PNUM = (SELECT PNUM FROM HU.WORKS WHERE HOURS = 80)
             END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 21000; its value is ", SQLSTATE

             PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE  NOT <  0  OR  NR-TAB  NOT  =   "21000") then
               MOVE 0 TO flag
             END-IF

      *13.5 <select statement: single row> GR2a
      *more than one row, with WHERE clause
             MOVE 33 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY  " "
             DISPLAY "SELECT HOURS INTO :tmpcnt FROM HU.WORKS WHERE
      -    " HOURS = 40;"
             EXEC SQL SELECT HOURS INTO :tmpcnt FROM HU.WORKS WHERE
             HOURS = 40 END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 21000; its value is ", SQLSTATE

             PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE  NOT <  0  OR  NR-TAB  NOT  =   "21000") then
               MOVE 0 TO flag
             END-IF

      *13.5 <select statement: single row> GR2a
      *more than one row, full-table select
             MOVE 33 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY  " "
             DISPLAY "SELECT HOURS INTO :tmpcnt FROM HU.WORKS;"
             EXEC SQL SELECT HOURS INTO :tmpcnt FROM HU.WORKS END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 21000; its value is ", SQLSTATE

             PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE  NOT <  0  OR  NR-TAB  NOT  =   "21000") then
               MOVE 0 TO flag
             END-IF

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0488','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml081.pco *** fail *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0488','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
      ******************** END TEST0488 ********************

      ******************** BEGIN TEST0489 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0489 "
             DISPLAY "SQLSTATE = 02000: no data"
             DISPLAY "Note: VALID implementation-defined subclass will
      -    " be"
             DISPLAY " accepted instead of no-subclass value of 000
      -    " "
             DISPLAY "Reference ANSI SQL-1992 section 22.1 SQLSTATE"
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

      *13.3 <fetch statement> GR 5b  - no data
             EXEC SQL DECLARE FATZERO CURSOR FOR
               SELECT GRADE FROM HU.STAFF WHERE GRADE < :xgrade END-EXEC

             MOVE 12 TO xgrade
             DISPLAY "Open cursor"
             EXEC SQL OPEN FATZERO END-EXEC
             MOVE SQLCODE TO SQL-COD
             COMPUTE SQLCODE = -55
             MOVE "x" TO SQLSTATE

      *one row in cursor - no data on second fetch
             DISPLAY "first FETCH gets data"
             EXEC SQL FETCH FATZERO INTO :tmpcnt END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 00000; its value is ", SQLSTATE
             PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE  NOT = 0 OR NR-TAB NOT = "00000") then
               MOVE 0 TO flag
             END-IF

             DISPLAY "next FETCH is past end of cursor"
             EXEC SQL FETCH FATZERO INTO :tmpcnt END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be 100; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 02000; its value is ", SQLSTATE
             PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE  NOT =  100  OR  NR-TAB  NOT  =   "02000") then
               MOVE 0 TO flag
             END-IF
             EXEC SQL CLOSE FATZERO END-EXEC
             MOVE SQLCODE TO SQL-COD

             DISPLAY  " "
             MOVE 9 TO xgrade
             DISPLAY "Open cursor"
             EXEC SQL OPEN FATZERO END-EXEC
             MOVE SQLCODE TO SQL-COD
             COMPUTE SQLCODE = -55
             MOVE "x" TO SQLSTATE

      *no rows in cursor - no data on first fetch
             DISPLAY "First FETCH on empty cursor"
             EXEC SQL FETCH FATZERO INTO :tmpcnt END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be 100; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 02000; its value is ", SQLSTATE
             PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE  NOT =  100  OR  NR-TAB  NOT  =   "02000") then
               MOVE 0 TO flag
             END-IF
             EXEC SQL CLOSE FATZERO END-EXEC
             MOVE SQLCODE TO SQL-COD

      *13.5 <select statement: single row> GR 2b - no data
             DISPLAY  " "
             COMPUTE SQLCODE = -55
             MOVE "x" TO SQLSTATE
             DISPLAY "SELECT GRADE INTO :tmpcnt FROM HU.STAFF WHERE
      -    " EMPNUM = 'xx';"
             EXEC SQL SELECT GRADE INTO :tmpcnt FROM HU.STAFF WHERE
             EMPNUM = 'xx' END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be 100; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 02000; its value is ", SQLSTATE
             PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE  NOT =  100  OR  NR-TAB  NOT  =   "02000") then
               MOVE 0 TO flag
             END-IF

      *13.7 <delete statement: searched> GR 5 - no data
             DISPLAY  " "
             COMPUTE SQLCODE = -55
             MOVE "x" TO SQLSTATE
             DISPLAY "DELETE FROM HU.STAFF WHERE GRADE = 11;"
             EXEC SQL DELETE FROM HU.STAFF WHERE GRADE = 11 END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be 100; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 02000; its value is ", SQLSTATE
             PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE  NOT =  100  OR  NR-TAB  NOT  =   "02000") then
               MOVE 0 TO flag
             END-IF

      *13.8 <insert statement> GR 4a - no data
             DISPLAY  " "
             COMPUTE SQLCODE = -55
             MOVE "x" TO SQLSTATE
             DISPLAY "INSERT INTO HU.STAFF (EMPNUM,GRADE)"
             DISPLAY " SELECT EMPNUM, 9 FROM HU.WORKS WHERE PNUM =
      -    " 'x9';"
             EXEC SQL INSERT INTO HU.STAFF (EMPNUM,GRADE)
               SELECT EMPNUM, 9 FROM HU.WORKS WHERE PNUM = 'x9' END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be 100; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 02000; its value is ", SQLSTATE
             PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE  NOT =  100  OR  NR-TAB  NOT  =   "02000") then
               MOVE 0 TO flag
             END-IF

      *13.10 <update statement: searched> GR 4 - no data
             DISPLAY  " "
             COMPUTE SQLCODE = -55
             MOVE "x" TO SQLSTATE
             DISPLAY "UPDATE HU.STAFF SET CITY = 'Ho' WHERE GRADE = 15;"
             EXEC SQL UPDATE HU.STAFF SET CITY = 'Ho' WHERE GRADE = 15
             END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be 100; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 02000; its value is ", SQLSTATE
             PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE  NOT =  100  OR  NR-TAB  NOT  =   "02000") then
               MOVE 0 TO flag
             END-IF

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

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0489','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml081.pco *** fail *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0489','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
      ******************** END TEST0489 ********************

      ******************** BEGIN TEST0490 *******************
             MOVE 1 TO flag
             MOVE 0 TO zeero

             DISPLAY " TEST0490 "
             DISPLAY "SQLSTATE = 22012: data exception (division by
      -    " zero)"
             DISPLAY "Reference ANSI SQL-1992 section 22.1 SQLSTATE"
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             DISPLAY "INSERT INTO HU.STAFF VALUES"
             DISPLAY " ('E6','Fidel',0,'Havana');"
             EXEC SQL INSERT INTO HU.STAFF
               VALUES ('E6','Fidel',0,'Havana') END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be 0; its value is ", SQL-COD
             if (SQLCODE  NOT =  0) then
               MOVE 0 TO flag
             END-IF

      *column reference in WHERE clause - divide by zero
             DISPLAY  " "
             MOVE 33 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY "SELECT COUNT(*) FROM HU.STAFF"
             DISPLAY "WHERE EMPNAME = 'Fidel' AND 16/GRADE > 2;"
             EXEC SQL SELECT COUNT(*) INTO :tmpcnt
               FROM HU.STAFF WHERE EMPNAME = 'Fidel' AND 16/GRADE > 2
             END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 22012; its value is ", SQLSTATE
             if (SQLCODE  NOT <  0  OR  SQLSTATE  NOT  =   "22012") then
               MOVE 0 TO flag
             END-IF

      *column reference in SELECT list - divide by zero
             DISPLAY  " "
             MOVE 33 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY "SELECT 16/GRADE FROM HU.STAFF "
             DISPLAY "WHERE EMPNAME = 'Fidel';"
             EXEC SQL SELECT 16/GRADE INTO :tmpcnt
               FROM HU.STAFF WHERE EMPNAME = 'Fidel' END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 22012; its value is ", SQLSTATE
             if (SQLCODE  NOT <  0  OR  SQLSTATE  NOT  =   "22012") then
               MOVE 0 TO flag
             END-IF

      *set function - divide by zero
             DISPLAY  " "
             MOVE 33 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY "SELECT COUNT(*) FROM HU.STAFF"
             DISPLAY "GROUP BY CITY HAVING SUM(GRADE/:zeero) > 44;"
           EXEC SQL DECLARE MAINT CURSOR FOR
           SELECT COUNT(*) FROM HU.STAFF
           GROUP BY CITY HAVING SUM(GRADE/:zeero) > 44 END-EXEC
           EXEC SQL OPEN MAINT END-EXEC
           if (SQLCODE = 0) then
             EXEC SQL FETCH MAINT INTO :tmpcnt END-EXEC
           END-IF
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 22012; its value is ", SQLSTATE
             if (SQLCODE  NOT <  0  OR  SQLSTATE  NOT  =   "22012") then
               MOVE 0 TO flag
             END-IF

      *subquery - divide by zero
             DISPLAY  " "
             MOVE 33 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY "SELECT COUNT(*) FROM HU.STAFF WHERE GRADE = "
             DISPLAY "(SELECT 16/GRADE FROM HU.STAFF WHERE EMPNUM =
      -    " 'E6');"
             EXEC SQL SELECT COUNT(*) INTO :tmpcnt FROM HU.STAFF WHERE
             GRADE =
               (SELECT 16/GRADE FROM HU.STAFF WHERE EMPNUM = 'E6')
             END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 22012; its value is ", SQLSTATE
             if (SQLCODE  NOT <  0  OR  SQLSTATE  NOT  =   "22012") then
               MOVE 0 TO flag
             END-IF

      *UPDATE with parameter value - divide by zero
             DISPLAY  " "
             MOVE 33 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY "UPDATE HU.STAFF SET GRADE = GRADE/:zeero WHERE
      -    " GRADE = 12"
             EXEC SQL UPDATE HU.STAFF SET GRADE = GRADE/:zeero WHERE
             GRADE = 12 END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 22012; its value is ", SQLSTATE
             if (SQLCODE  NOT <  0  OR  SQLSTATE  NOT  =   "22012") then
               MOVE 0 TO flag
             END-IF

      *INSERT with parameter value - divide by zero
             DISPLAY  " "
             MOVE 33 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY "INSERT INTO HU.STAFF SELECT"
             DISPLAY "'X','Y',HOURS/:zeero,'z' FROM HU.WORKS WHERE PNUM
      -    " = 'P6' "
             EXEC SQL INSERT INTO HU.STAFF SELECT
               'X','Y',HOURS/:zeero,'z' FROM HU.WORKS WHERE PNUM = 'P6'
             END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 22012; its value is ", SQLSTATE
             if (SQLCODE  NOT <  0  OR  SQLSTATE  NOT  =   "22012") then
               MOVE 0 TO flag
             END-IF

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

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0490','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml081.pco *** fail *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0490','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
      ******************** END TEST0490 ********************

      ******************** BEGIN TEST0502 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0502 "
             DISPLAY "SQLSTATE = 24000: invalid cursor state"
             DISPLAY "Note: VALID implementation-defined subclass will
      -    " be"
             DISPLAY " accepted instead of no-subclass value of 000
      -    " "
             DISPLAY "Reference ANSI SQL-1992 section 22.1 SQLSTATE"
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             DISPLAY "DECLARE COLUMBIA CURSOR FOR SELECT GRADE FROM
      -    " HU.STAFF;"
             EXEC SQL DECLARE COLUMBIA CURSOR FOR
               SELECT GRADE FROM HU.STAFF END-EXEC

      *13.2 <open statement> GR1
             DISPLAY "OPEN COLUMBIA;"
             EXEC SQL OPEN COLUMBIA END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "FETCH COLUMBIA INTO :tmpcnt;"
             EXEC SQL FETCH COLUMBIA INTO :tmpcnt END-EXEC
             MOVE SQLCODE TO SQL-COD
             MOVE 33 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY "OPEN COLUMBIA;"
             EXEC SQL OPEN COLUMBIA END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be '24000'; its value is ",
             SQLSTATE
             PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE  NOT <  0  OR  NR-TAB  NOT  =   "24000") then
               MOVE 0 TO flag
             END-IF
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "COMMIT WORK;"

      *13.3 <fetch statement> GR1
             DISPLAY  " "
             MOVE 33 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY "FETCH COLUMBIA INTO :tmpcnt;"
             EXEC SQL FETCH COLUMBIA INTO :tmpcnt END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be '24000'; its value is ",
             SQLSTATE
             PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE  NOT <  0  OR  NR-TAB  NOT  =   "24000") then
               MOVE 0 TO flag
             END-IF
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "COMMIT WORK;"

      *13.4 <close statement> GR1
             DISPLAY  " "
             MOVE 33 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY "CLOSE COLUMBIA;"
             EXEC SQL CLOSE COLUMBIA END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be '24000'; its value is ",
             SQLSTATE
             PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE  NOT <  0  OR  NR-TAB  NOT  =   "24000") then
               MOVE 0 TO flag
             END-IF
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "COMMIT WORK;"

      *13.6 <delete statement: positioned> GR2 - before first row
             DISPLAY  " "
             DISPLAY "OPEN COLUMBIA;"
             EXEC SQL OPEN COLUMBIA END-EXEC
             MOVE SQLCODE TO SQL-COD
             MOVE 33 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY "DELETE FROM HU.STAFF WHERE CURRENT OF COLUMBIA;"
             EXEC SQL DELETE FROM HU.STAFF WHERE CURRENT OF COLUMBIA
             END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be '24000'; its value is ",
             SQLSTATE
             PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE  NOT <  0  OR  NR-TAB  NOT  =   "24000") then
               MOVE 0 TO flag
             END-IF
             EXEC SQL ROLLBACK WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "ROLLBACK WORK;"

      *13.6 <delete statement: positioned> GR2 - after last row
             DISPLAY  " "
             DISPLAY "OPEN COLUMBIA;"
             EXEC SQL OPEN COLUMBIA END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "FETCH COLUMBIA cursor 13 times. Now positioned
      -    " past end."
             MOVE 0 TO ii
             PERFORM P50 UNTIL ii > 12
             MOVE 33 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY "DELETE FROM HU.STAFF WHERE CURRENT OF COLUMBIA;"
             EXEC SQL DELETE FROM HU.STAFF WHERE CURRENT OF COLUMBIA
             END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be '24000'; its value is ",
             SQLSTATE
             PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE  NOT <  0  OR  NR-TAB  NOT  =   "24000") then
               MOVE 0 TO flag
             END-IF
             EXEC SQL ROLLBACK WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "ROLLBACK WORK;"

      *13.9 <update statement: positioned> GR2 - deleted row
             DISPLAY  " "
             DISPLAY "OPEN COLUMBIA;"
             EXEC SQL OPEN COLUMBIA END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "FETCH COLUMBIA INTO :tmpcnt;"
             EXEC SQL FETCH COLUMBIA INTO :tmpcnt END-EXEC
             MOVE SQLCODE TO SQL-COD
             MOVE 33 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY  " "
             DISPLAY "DELETE FROM HU.STAFF WHERE CURRENT OF COLUMBIA;"
             EXEC SQL DELETE FROM HU.STAFF WHERE CURRENT OF COLUMBIA
             END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be '00000'; its value is ",
             SQLSTATE
             PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE  NOT = 0 OR NR-TAB NOT = "00000") then
               MOVE 0 TO flag
             END-IF
             MOVE 33 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY "UPDATE HU.STAFF ... WHERE CURRENT OF COLUMBIA;"
             EXEC SQL UPDATE HU.STAFF SET GRADE = :tmpcnt WHERE CURRENT
             OF COLUMBIA END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be '24000'; its value is ",
             SQLSTATE
             PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE  NOT <  0  OR  NR-TAB  NOT  =   "24000") then
               MOVE 0 TO flag
             END-IF
             EXEC SQL ROLLBACK WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "ROLLBACK WORK;"

      *13.9 <update statement: positioned> GR2 - after last row
             DISPLAY  " "
             DISPLAY "OPEN COLUMBIA;"
             EXEC SQL OPEN COLUMBIA END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "FETCH COLUMBIA cursor 13 times. Now positioned
      -    " past end."
             MOVE 0 TO ii
             PERFORM P49 UNTIL ii > 12
             MOVE 33 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY "UPDATE HU.STAFF ... WHERE CURRENT OF COLUMBIA;"
             EXEC SQL UPDATE HU.STAFF SET GRADE = :tmpcnt WHERE CURRENT
             OF COLUMBIA END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be '24000'; its value is ",
             SQLSTATE
             PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE  NOT <  0  OR  NR-TAB  NOT  =   "24000") then
               MOVE 0 TO flag
             END-IF
             EXEC SQL ROLLBACK WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0502','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml081.pco *** fail *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0502','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
      ******************** END TEST0502 ********************

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

      *    ****  Procedures for PERFORM statements

        P50.
               EXEC SQL FETCH COLUMBIA INTO :tmpcnt END-EXEC
               MOVE SQLCODE TO SQL-COD
             ADD 1 TO ii
           .

        P49.
               EXEC SQL FETCH COLUMBIA INTO :tmpcnt END-EXEC
               MOVE SQLCODE TO SQL-COD
             ADD 1 TO ii
           .
       NOSUBCLASS.

      *This routine replaces valid implementation-defined
      *subclasses with 000.  This replacement equates valid
      *implementation-defined subclasses with the 000 value
      *expected by the test case; otherwise the test will fail.
      *After calling NOSUBCLASS, NORMSQ will be tested
      *                          SQLSTATE will be printed.

           MOVE SQLSTATE TO NR-TAB

           MOVE 3 TO norm1
      *subclass begins in position 3 of char array NORMSQ
           MOVE 14 TO norm2
           PERFORM P90 UNTIL norm2 > 36

           if (NR-TAB   =   SQLSTATE) then
             GO TO EXIT-NOSUBCLASS
           END-IF
      *Quit if NORMSQ is unchanged.  Subclass is not impl.-def.
      *Changed NORMSQ means implementation-defined subclass,
      *so proceed to zero it out, if valid (0-9,A-Z)

           MOVE 4 TO norm1
      *examining position 4 of char array NORMSQ
           MOVE 1 TO norm2
           PERFORM P89 UNTIL norm2 > 36

           MOVE 5 TO norm1
      *examining position 5 of char array NORMSQ
           MOVE 1 TO norm2
           PERFORM P88 UNTIL norm2 > 36


      *implementation-defined subclasses are allowed for warnings
      *(class = 01).  These equate to successful completion
      *SQLSTATE values of 00000.
      *Reference SQL-92 4.28 SQL-transactions, paragraph 2

           if (NORMSQ(1)  =  "0"  AND  NORMSQ(2)  =  "1") then
             MOVE "0" TO NORMSQ(2)
           END-IF
           GO TO EXIT-NOSUBCLASS
           .

       P90.
      *valid subclass begins with 5-9, I-Z, end of ALPNUM table
           if (NORMSQ(norm1)  =  ALPNUM(norm2)) then
             MOVE "0" TO NORMSQ(norm1)
           END-IF
           ADD 1 TO norm2
           .

       P89.
      *valid characters are 0-9, A-Z
           if (NORMSQ(norm1)  =  ALPNUM(norm2)) then
             MOVE "0" TO NORMSQ(norm1)
           END-IF
           ADD 1 TO norm2
           .

       P88.
      *valid characters are 0-9, A-Z
           if (NORMSQ(norm1)  =  ALPNUM(norm2)) then
             MOVE "0" TO NORMSQ(norm1)
           END-IF
           ADD 1 TO norm2
           .

       EXIT-NOSUBCLASS.
           EXIT.

quality100%

¤ Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.0.26Bemerkung: Wie Sie bei der Firma Beratungs- und Dienstleistungen beauftragen können ¤

*Bot Zugriff

Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.

Bemerkung:

Die farbliche Syntaxdarstellung ist noch experimentell.