|
IDENTIFICATION DIVISION.
PROGRAM-ID. DML081.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. xyz.
OBJECT-COMPUTER. xyz.
DATA DIVISION.
WORKING-STORAGE SECTION.
* Standard COBOL (file "DML081.SCO") calling SQL
* procedures in file "DML081.MCO".
* STANDARD COBOL (file "DML081.SCO")
****************************************************************
*
* COMMENT SECTION
*
* DATE 1992/07/06 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.
*
* DML081.SCO
* 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.
* EXEC SQL END DECLARE SECTION END-EXEC
01 ii PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 SQLCODE PIC S9(9) COMP.
01 SQLSTATE PIC X(5).
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;
CALL "SUB1" USING SQLCODE SQLSTATE uidx
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, Standard COBOL, dml081.sco"
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
* ;
CALL "SUB2" USING SQLCODE SQLSTATE tmpcnt
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','MCO');
CALL "SUB3" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " dml081.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0487','fail','MCO');
CALL "SUB4" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB5" USING SQLCODE SQLSTATE
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)
* ;
CALL "SUB6" USING SQLCODE SQLSTATE tmpcnt
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;
CALL "SUB7" USING SQLCODE SQLSTATE tmpcnt
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;
CALL "SUB8" USING SQLCODE SQLSTATE tmpcnt
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','MCO');
CALL "SUB9" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " dml081.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0488','fail','MCO');
CALL "SUB10" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB11" USING SQLCODE SQLSTATE
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;
CALL "SUB12" USING SQLCODE SQLSTATE xgrade
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;
CALL "SUB13" USING SQLCODE SQLSTATE tmpcnt
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;
CALL "SUB14" USING SQLCODE SQLSTATE tmpcnt
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;
CALL "SUB15" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
DISPLAY " "
MOVE 9 TO xgrade
DISPLAY "Open cursor"
* EXEC SQL OPEN FATZERO;
CALL "SUB12" USING SQLCODE SQLSTATE xgrade
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;
CALL "SUB17" USING SQLCODE SQLSTATE tmpcnt
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;
CALL "SUB18" USING SQLCODE SQLSTATE
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';
CALL "SUB19" USING SQLCODE SQLSTATE tmpcnt
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;
CALL "SUB20" USING SQLCODE SQLSTATE
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';
CALL "SUB21" USING SQLCODE SQLSTATE
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
* ;
CALL "SUB22" USING SQLCODE SQLSTATE
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;
CALL "SUB23" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
if ( flag = 1 ) then
DISPLAY " *** pass *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0489','pass','MCO');
CALL "SUB24" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " dml081.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0489','fail','MCO');
CALL "SUB25" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB26" USING SQLCODE SQLSTATE
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');
CALL "SUB27" USING SQLCODE SQLSTATE
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
* ;
CALL "SUB28" USING SQLCODE SQLSTATE tmpcnt
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';
CALL "SUB29" USING SQLCODE SQLSTATE tmpcnt
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 "Cursor SELECT COUNT(*) FROM HU.STAFF"
DISPLAY "GROUP BY CITY HAVING SUM(GRADE/:zeero) > 44;"
* EXEC SQL Cursor SELECT COUNT(*) INTO :tmpcnt FROM HU.STAFF
* GROUP BY CITY HAVING SUM(GRADE/:zeero) > 44;
CALL "OPENM" USING SQLCODE SQLSTATE zeero
if (SQLCODE = 0) then
CALL "SUB30" USING SQLCODE SQLSTATE tmpcnt zeero
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')
* ;
CALL "SUB31" USING SQLCODE SQLSTATE tmpcnt
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;
CALL "SUB32" USING SQLCODE SQLSTATE zeero
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'
* ;
CALL "SUB33" USING SQLCODE SQLSTATE zeero
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;
CALL "SUB34" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
if ( flag = 1 ) then
DISPLAY " *** pass *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0490','pass','MCO');
CALL "SUB35" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " dml081.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0490','fail','MCO');
CALL "SUB36" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB37" USING SQLCODE SQLSTATE
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;
CALL "SUB38" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
DISPLAY "FETCH COLUMBIA INTO :tmpcnt;"
* EXEC SQL FETCH COLUMBIA INTO :tmpcnt;
CALL "SUB39" USING SQLCODE SQLSTATE tmpcnt
MOVE SQLCODE TO SQL-COD
MOVE 33 TO SQLCODE
MOVE "x" TO SQLSTATE
DISPLAY "OPEN COLUMBIA;"
* EXEC SQL OPEN COLUMBIA;
CALL "SUB38" USING SQLCODE SQLSTATE
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;
CALL "SUB41" USING SQLCODE SQLSTATE
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;
CALL "SUB42" USING SQLCODE SQLSTATE tmpcnt
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;
CALL "SUB43" USING SQLCODE SQLSTATE
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;
CALL "SUB44" USING SQLCODE SQLSTATE
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;
CALL "SUB45" USING SQLCODE SQLSTATE
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;
CALL "SUB38" USING SQLCODE SQLSTATE
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
* ;
CALL "SUB47" USING SQLCODE SQLSTATE
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;
CALL "SUB48" USING SQLCODE SQLSTATE
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;
CALL "SUB38" USING SQLCODE SQLSTATE
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
* ;
CALL "SUB50" USING SQLCODE SQLSTATE
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;
CALL "SUB51" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
DISPLAY "ROLLBACK WORK;"
*13.9 <update statement: positioned> GR2 - deleted row
DISPLAY " "
DISPLAY "OPEN COLUMBIA;"
* EXEC SQL OPEN COLUMBIA;
CALL "SUB38" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
DISPLAY "FETCH COLUMBIA INTO :tmpcnt;"
* EXEC SQL FETCH COLUMBIA INTO :tmpcnt;
CALL "SUB53" USING SQLCODE SQLSTATE tmpcnt
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
* ;
CALL "SUB54" USING SQLCODE SQLSTATE
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;
CALL "SUB55" USING SQLCODE SQLSTATE tmpcnt
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;
CALL "SUB56" USING SQLCODE SQLSTATE
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;
CALL "SUB38" USING SQLCODE SQLSTATE
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;
CALL "SUB58" USING SQLCODE SQLSTATE tmpcnt
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;
CALL "SUB59" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
if ( flag = 1 ) then
DISPLAY " *** pass *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0502','pass','MCO');
CALL "SUB60" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " dml081.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0502','fail','MCO');
CALL "SUB61" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB62" USING SQLCODE SQLSTATE
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;
CALL "SUB63" USING SQLCODE SQLSTATE tmpcnt
MOVE SQLCODE TO SQL-COD
ADD 1 TO ii
.
P49.
* EXEC SQL FETCH COLUMBIA INTO :tmpcnt;
CALL "SUB64" USING SQLCODE SQLSTATE tmpcnt
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.60 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.
|
