|
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.
¤ Dauer der Verarbeitung: 0.35 Sekunden
(vorverarbeitet)
¤
|
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.
|
