IDENTIFICATION DIVISION.
PROGRAM-ID. DML082.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. xyz.
OBJECT-COMPUTER. xyz.
DATA DIVISION.
WORKING-STORAGE SECTION.
* Standard COBOL (file "DML082.SCO") calling SQL
* procedures in file "DML082.MCO".
* STANDARD COBOL (file "DML082.SCO")
****************************************************************
*
* COMMENT SECTION
*
* DATE 1992/07/07 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.
*
* DML082.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 indic1 PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 huge PIC X(1).
01 tmpcnt PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 SMALL1 PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 LONG1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 esch1 PIC X(1).
01 esch2 PIC X(2).
01 patrn6 PIC X(6).
01 patrn7 PIC X(7).
01 colval PIC X(15).
* EXEC SQL END DECLARE SECTION END-EXEC
01 SQLCD1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 ii PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 i33000 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 maxlon PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 loopct 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 SQLST1 PIC X(5).
01 testst PIC X(5).
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 flag2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 flag3 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
DISPLAY
"SQL Test Suite, V6.0, Standard COBOL, dml082.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 TEST0491 *******************
MOVE 0 TO flag
DISPLAY " TEST0491 "
DISPLAY "SQLSTATE = 22022: data exception (indicator
- " overflow)"
DISPLAY "Reference ANSI SQL-1992 section 9.1 Retrieval
- " assignment"
DISPLAY " General Rule #2"
DISPLAY " - - - - - - - - - - - - - - - - - - -"
*This test is assumed passed if the database cannot create
*a CHAR column of size 33000 for table FLATER.TINY. It is
*also passed by the program logic if the type of the
*indicator variable gets changed to long int.
*42000, the SQLSTATE for syntax error or access rule
*violation, reflects the fact that a nonexistent table
*has been queried. If the test will not compile because
*TINY does not exist, save the error message and use TEd
*to delete this test case: it is a pass.
MOVE 33000 TO i33000
COMPUTE indic1 = -44
MOVE 0 TO tmpcnt
MOVE "z" TO huge
* EXEC SQL DELETE FROM FLATER.TINY;
CALL "SUB2" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO FLATER.TINY VALUES
* ('Too long for its own good!');
CALL "SUB3" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
MOVE 44 TO SQLCODE
MOVE "x" TO SQLSTATE
DISPLAY "SELECT COUNT(*) INTO :tmpcnt FROM FLATER.TINY;"
DISPLAY "(SQLCD1=SQLCODE, SQLST1=SQLSTATE for this SELECT
- " COUNT(*))"
* EXEC SQL SELECT COUNT(*) INTO :tmpcnt FROM FLATER.TINY
* ;
CALL "SUB4" USING SQLCODE SQLSTATE tmpcnt
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO SQLCD1
MOVE SQLSTATE TO SQLST1
PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
MOVE NR-TAB TO testst
MOVE 44 TO SQLCODE
MOVE "x" TO SQLSTATE
DISPLAY "SELECT C1 INTO :huge:indic1 FROM FLATER.TINY;"
* EXEC SQL SELECT C1 INTO :huge:indic1 FROM FLATER.TINY
* ;
CALL "SUB5" USING SQLCODE SQLSTATE huge indic1
MOVE SQLCODE TO SQL-COD
PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
DISPLAY " "
DISPLAY "To pass, you need EITHER:"
DISPLAY "No such table!"
DISPLAY " SQLCD1 < 0, SQLST1 = '42000',"
DISPLAY " SQLCODE < 0, and SQLSTATE = '42000'"
DISPLAY " "
DISPLAY "OR:"
DISPLAY "Indicator overflow!"
DISPLAY " SQLCD1 = 0, SQLST1 = '00000', tmpcnt =
- " 1"
DISPLAY " SQLCODE < 0, and SQLSTATE = '22022'"
DISPLAY " "
DISPLAY "OR:"
DISPLAY "Successful completion!"
DISPLAY " SQLCD1 = 0, SQLST1 = '00000', tmpcnt =
- " 1"
DISPLAY " SQLCODE >= 0, SQLSTATE = '01004'"
DISPLAY " indic1 = 33000, and huge = 'T'"
DISPLAY " "
DISPLAY "SQLCD1 is ", SQLCD1 "; SQLST1 is ", SQLST1
DISPLAY "tmpcnt is ", tmpcnt
DISPLAY "SQLCODE is ", SQL-COD "; SQLSTATE is ", SQLSTATE
if (SQLCODE = 0) then
DISPLAY "indic1 is ", indic1 "; huge is ", huge " "
END-IF
*test for no such table
MOVE 0 TO flag2
if (SQLCD1 < 0 AND testst = "42000") then
MOVE 1 TO flag2
END-IF
if (flag2 = 1 AND SQLCODE < 0 AND NR-TAB =
"42000") then
MOVE 1 TO flag
END-IF
*test for indicator overflow
MOVE 0 TO flag2
if (SQLCD1 = 0 AND testst = "00000" AND tmpcnt =
1) then
MOVE 1 TO flag2
END-IF
if (flag2 = 1 AND SQLCODE < 0 AND SQLSTATE =
"22022") then
MOVE 1 TO flag
END-IF
*test for successful completion
MOVE 0 TO flag2
MOVE 0 TO flag3
if (SQLCD1 = 0 AND testst = "00000" AND tmpcnt =
1) then
MOVE 1 TO flag2
END-IF
if (flag2 = 1 AND SQLCODE NOT < 0 AND NR-TAB =
"01004") then
MOVE 1 TO flag3
END-IF
if (flag3 = 1 AND indic1 = i33000 AND huge =
"T") then
MOVE 1 TO flag
END-IF
* EXEC SQL ROLLBACK WORK;
CALL "SUB6" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
if ( flag = 1 ) then
DISPLAY " *** pass *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0491','pass','MCO');
CALL "SUB7" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " dml082.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0491','fail','MCO');
CALL "SUB8" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB9" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
******************** END TEST0491 ********************
******************** BEGIN TEST0492 *******************
MOVE 1 TO flag
DISPLAY " TEST0492 "
DISPLAY "SQLSTATE = 22019: data exception (invalid escape
- " char)"
DISPLAY "Reference ANSI SQL-1992 section 8.5
- " predicate>"
DISPLAY " General Rule #3"
DISPLAY " - - - - - - - - - - - - - - - - - - -"
MOVE "Percent%Xunder_" TO colval
DISPLAY "UPDATE HU.STAFF SET CITY = ", colval
DISPLAY " WHERE EMPNUM = 'E1';"
* EXEC SQL UPDATE HU.STAFF SET CITY = :colval
* WHERE EMPNUM = 'E1';
CALL "SUB10" USING SQLCODE SQLSTATE colval
MOVE SQLCODE TO SQL-COD
DISPLAY " "
*Subtest 0492a begins.
*If it will not compile, save error message
*and then delete the subtest with TEd "hooks".
*literal escape character - 2-byte escape char
MOVE 44 TO SQLCODE
MOVE "x" TO SQLSTATE
MOVE "%XX%X_%" TO patrn7
DISPLAY "SELECT COUNT(*) FROM HU.STAFF WHERE"
DISPLAY "CITY LIKE ", patrn7 " ESCAPE 'XX';"
* EXEC SQL SELECT COUNT(*) INTO :tmpcnt
* FROM HU.STAFF WHERE CITY
* LIKE '%XX%X_%' ESCAPE 'XX';
CALL "SUB11" USING SQLCODE SQLSTATE tmpcnt
MOVE SQLCODE TO SQL-COD
DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
DISPLAY "SQLSTATE should be '22019'; its value is ",
SQLSTATE
if (SQLCODE NOT < 0 OR SQLSTATE NOT = "22019") then
MOVE 0 TO flag
END-IF
*Subtest 0492a ends
*literal escape character - 1-byte escape char
MOVE 44 TO SQLCODE
MOVE "x" TO SQLSTATE
COMPUTE tmpcnt = -1
DISPLAY " "
MOVE "%XX%X_%" TO patrn7
DISPLAY "SELECT COUNT(*) INTO :tmpcnt FROM HU.STAFF WHERE"
DISPLAY "CITY LIKE ", patrn7 " ESCAPE 'X';"
* EXEC SQL SELECT COUNT(*) INTO :tmpcnt
* FROM HU.STAFF WHERE CITY LIKE '%XX%X_%' ESCAPE 'X'
* ;
CALL "SUB12" USING SQLCODE SQLSTATE tmpcnt
MOVE SQLCODE TO SQL-COD
DISPLAY "tmpcnt should be 1; its value is ", tmpcnt
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 (tmpcnt NOT = 1 OR SQLCODE NOT = 0 OR NR-TAB
NOT = "00000") then
MOVE 0 TO flag
END-IF
*Subtest 0492c begins.
*If it will not compile, save error message
*and then delete the subtest with TEd "hooks".
*parameter escape character - 2-byte escape char
MOVE 44 TO SQLCODE
MOVE "x" TO SQLSTATE
MOVE "XX" TO esch2
DISPLAY " "
MOVE "%XX_%" TO patrn7
DISPLAY "SELECT COUNT(*) INTO :tmpcnt FROM HU.STAFF WHERE"
DISPLAY "CITY LIKE ", patrn7 " ESCAPE :esch2;"
DISPLAY "Note that esch2 = 'XX'"
* EXEC SQL SELECT COUNT(*) INTO :tmpcnt
* FROM HU.STAFF WHERE CITY
* LIKE '%XX_%' ESCAPE :esch2;
CALL "SUB13" USING SQLCODE SQLSTATE tmpcnt esch2
MOVE SQLCODE TO SQL-COD
DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
DISPLAY "SQLSTATE should be '22019'; its value is ",
SQLSTATE
if (SQLCODE NOT < 0 OR SQLSTATE NOT = "22019") then
MOVE 0 TO flag
END-IF
*Subtest 0492c ends
*parameter escape character - 1-byte escape char
MOVE 44 TO SQLCODE
MOVE "x" TO SQLSTATE
MOVE "X" TO esch1
COMPUTE tmpcnt = -1
DISPLAY " "
MOVE "%XX_%" TO patrn7
DISPLAY "SELECT COUNT(*) FROM HU.STAFF WHERE"
DISPLAY "CITY LIKE ", patrn7 " ESCAPE :esch1;"
DISPLAY "Note that esch1 = 'X'"
* EXEC SQL SELECT COUNT(*) INTO :tmpcnt
* FROM HU.STAFF WHERE CITY
* LIKE '%XX_%' ESCAPE :esch1;
CALL "SUB14" USING SQLCODE SQLSTATE tmpcnt esch1
MOVE SQLCODE TO SQL-COD
DISPLAY "tmpcnt should be 1; its value is ", tmpcnt
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 (tmpcnt NOT = 1 OR SQLCODE NOT = 0 OR NR-TAB
NOT = "00000") then
MOVE 0 TO flag
END-IF
* EXEC SQL ROLLBACK WORK;
CALL "SUB15" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
if ( flag = 1 ) then
DISPLAY " *** pass *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0492','pass','MCO');
CALL "SUB16" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " dml082.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0492','fail','MCO');
CALL "SUB17" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB18" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
******************** END TEST0492 ********************
******************** BEGIN TEST0493 *******************
MOVE 1 TO flag
DISPLAY " TEST0493 "
DISPLAY "SQLSTATE = 22025: data exception (invalid escape
- " sequence)"
DISPLAY "Reference ANSI SQL-1992 section 8.5
- " predicate>"
DISPLAY " General Rule #3"
DISPLAY " - - - - - - - - - - - - - - - - - - -"
MOVE "Per%X&und_" TO colval
* EXEC SQL DELETE FROM CPBASE;
CALL "SUB19" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
DISPLAY "INSERT INTO CPBASE VALUES (82,'Per%X&und_')"
* EXEC SQL INSERT INTO CPBASE VALUES (82,'Per%X&und_')
* ;
CALL "SUB20" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
*Subtest 0493a begins.
*If it will not compile, save error message
*and then delete the subtest with TEd "hooks".
*SELECT...LIKE, literal escape char, literal pattern -
*pattern ends with escape char
MOVE 44 TO SQLCODE
MOVE "x" TO SQLSTATE
DISPLAY " "
MOVE "P%X%%X" TO patrn7
DISPLAY "SELECT COUNT(*) FROM CPBASE WHERE"
DISPLAY "JUNK1 LIKE ", patrn7 " ESCAPE 'X';"
* EXEC SQL SELECT COUNT(*) INTO :tmpcnt
* FROM CPBASE WHERE JUNK1
* LIKE 'P%X%%X' ESCAPE 'X';
CALL "SUB21" USING SQLCODE SQLSTATE tmpcnt
MOVE SQLCODE TO SQL-COD
DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
DISPLAY "SQLSTATE should be '22025'; its value is ",
SQLSTATE
if (SQLCODE NOT < 0 OR SQLSTATE NOT = "22025") then
MOVE 0 TO flag
END-IF
*Subtest 0493a ends
*variation that should work - remove last X in pattern
COMPUTE tmpcnt = -1
MOVE 44 TO SQLCODE
MOVE "x" TO SQLSTATE
MOVE "P%X%%" TO patrn7
DISPLAY " "
DISPLAY "SELECT COUNT(*) INTO :tmpcnt FROM CPBASE"
DISPLAY " WHERE JUNK1 LIKE ", patrn7 " ESCAPE 'X';"
* EXEC SQL SELECT COUNT(*) INTO :tmpcnt
* FROM CPBASE WHERE JUNK1
* LIKE 'P%X%%' ESCAPE 'X';
CALL "SUB22" USING SQLCODE SQLSTATE tmpcnt
MOVE SQLCODE TO SQL-COD
DISPLAY "After removing the last X in the pattern:"
DISPLAY "tmpcnt should be 1; its value is ", tmpcnt
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 (tmpcnt NOT = 1 OR SQLCODE NOT = 0 OR NR-TAB
NOT = "00000") then
MOVE 0 TO flag
END-IF
*Subtest 0493c begins.
*If it will not compile, save error message
*and then delete the subtest with TEd "hooks".
*INSERT...LIKE, literal escape char, parameter pattern -
*escape char in pattern not followed by
*percent, underscore, escape char
MOVE 44 TO SQLCODE
MOVE "x" TO SQLSTATE
DISPLAY " "
MOVE "%X%%Xd_" TO patrn7
DISPLAY "INSERT INTO HU.STAFF"
DISPLAY "SELECT 'E12','ff',KC,'gg' FROM CPBASE"
DISPLAY "WHERE JUNK1 LIKE :patrn7 ESCAPE 'X';"
* EXEC SQL INSERT INTO HU.STAFF
* SELECT 'E12','ff',KC,'gg' FROM CPBASE
* WHERE JUNK1 LIKE :patrn7 ESCAPE 'X';
CALL "SUB23" USING SQLCODE SQLSTATE patrn7
MOVE SQLCODE TO SQL-COD
DISPLAY "Note that patrn7 = ", patrn7
DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
DISPLAY "SQLSTATE should be '22025'; its value is ",
SQLSTATE
if (SQLCODE NOT < 0 OR SQLSTATE NOT = "22025") then
MOVE 0 TO flag
END-IF
*Subtest 0493c ends
*variation that should work - remove the "d" in pattern
MOVE "%X%%X_" TO patrn6
MOVE 44 TO SQLCODE
MOVE "x" TO SQLSTATE
DISPLAY " "
DISPLAY "INSERT INTO HU.STAFF SELECT 'E13','ff',KC,'gg'"
DISPLAY "FROM CPBASE WHERE JUNK1 LIKE :patrn6 ESCAPE 'X';"
* EXEC SQL INSERT INTO HU.STAFF
* SELECT 'E13','ff',KC,'gg' FROM CPBASE
* WHERE JUNK1 LIKE :patrn6 ESCAPE 'X';
CALL "SUB24" USING SQLCODE SQLSTATE patrn6
MOVE SQLCODE TO SQL-COD
DISPLAY "After removing the 'd' in the pattern:"
DISPLAY "Note that patrn6 = ", patrn6
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
*Subtest 0493e begins.
*If it will not compile, save error message
*and then delete the subtest with TEd "hooks".
*UPDATE...LIKE, parameter escape char, literal pattern -
*escape char in pattern not followed by
*percent, underscore, escape char
MOVE 44 TO SQLCODE
MOVE "x" TO SQLSTATE
DISPLAY " "
MOVE "?" TO esch1
MOVE "%?X%" TO patrn7
DISPLAY "UPDATE CPBASE SET KC = -1 "
DISPLAY "WHERE JUNK1 LIKE ", patrn7 " ESCAPE :esch1;"
* EXEC SQL UPDATE CPBASE SET KC = -1
* WHERE JUNK1 LIKE '%?X%' ESCAPE :esch1;
CALL "SUB25" USING SQLCODE SQLSTATE esch1
MOVE SQLCODE TO SQL-COD
DISPLAY "Note that esch1 = ", esch1
DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
DISPLAY "SQLSTATE should be '22025'; its value is ",
SQLSTATE
if (SQLCODE NOT < 0 OR SQLSTATE NOT = "22025") then
MOVE 0 TO flag
END-IF
*Subtest 0493e ends
*variation that should work - add a % after escape char in patte
MOVE 44 TO SQLCODE
MOVE "x" TO SQLSTATE
MOVE "?" TO esch1
MOVE "%?%X%" TO patrn7
DISPLAY " "
DISPLAY "UPDATE CPBASE SET KC = -1"
DISPLAY "WHERE JUNK1 LIKE ", patrn7 " ESCAPE :esch1;"
* EXEC SQL UPDATE CPBASE SET KC = -1
* WHERE JUNK1 LIKE '%?%X%' ESCAPE :esch1;
CALL "SUB26" USING SQLCODE SQLSTATE esch1
MOVE SQLCODE TO SQL-COD
DISPLAY "After adding a percent in the middle of the
- " pattern:"
DISPLAY "Note that esch1 = ", esch1
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
*Subtest 0493g begins.
*If it will not compile, save error message
*and then delete the subtest with TEd "hooks".
*DELETE... LIKE, parameter escape char, parameter pattern -
*escape char in pattern not followed by
*percent, underscore, escape char
MOVE 44 TO SQLCODE
MOVE "x" TO SQLSTATE
DISPLAY " "
MOVE "&" TO esch1
MOVE "_e%&u%" TO patrn6
DISPLAY "DELETE FROM CPBASE"
DISPLAY "WHERE JUNK1 LIKE :patrn6 ESCAPE :esch1;"
* EXEC SQL DELETE FROM CPBASE
* WHERE JUNK1 LIKE :patrn6 ESCAPE :esch1;
CALL "SUB27" USING SQLCODE SQLSTATE patrn6 esch1
MOVE SQLCODE TO SQL-COD
DISPLAY "Note that patrn6 = ", patrn6 " and escape char =",
esch1
DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
DISPLAY "SQLSTATE should be '22025'; its value is ",
SQLSTATE
if (SQLCODE NOT < 0 OR SQLSTATE NOT = "22025") then
MOVE 0 TO flag
END-IF
*Subtest 0493g ends
*variation that should work - add an & in pattern
MOVE 44 TO SQLCODE
MOVE "x" TO SQLSTATE
MOVE "&" TO esch1
MOVE "_e%&&u%" TO patrn7
DISPLAY " "
DISPLAY "DELETE FROM CPBASE"
DISPLAY "WHERE JUNK1 LIKE :patrn7 ESCAPE :esch1;"
* EXEC SQL DELETE FROM CPBASE
* WHERE JUNK1 LIKE :patrn7 ESCAPE :esch1;
CALL "SUB28" USING SQLCODE SQLSTATE patrn7 esch1
MOVE SQLCODE TO SQL-COD
DISPLAY "After adding an ampersand in the middle of the
- " pattern:"
DISPLAY "Note that patrn7 = ", patrn7 " and escape char =",
esch1
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
* EXEC SQL ROLLBACK WORK;
CALL "SUB29" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
if ( flag = 1 ) then
DISPLAY " *** pass *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0493','pass','MCO');
CALL "SUB30" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " dml082.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0493','fail','MCO');
CALL "SUB31" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB32" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
******************** END TEST0493 ********************
******************** BEGIN TEST0494 *******************
MOVE 1 TO flag
DISPLAY " TEST0494 "
DISPLAY "SQLSTATE = 22003: data exception "
DISPLAY "(numeric value out of range)"
DISPLAY "Reference ANSI SQL-1992 section 9.1 GR 3k "
DISPLAY " and section 9.2 GR 3k"
DISPLAY " - - - - - - - - - - - - - - - - - - -"
*Subtest 0494a begins.
*If it will not compile, save error message
*and then delete the subtest with TEd "hooks".
*insert larger and larger long parameter
DISPLAY " "
* EXEC SQL DELETE FROM HU.HH;
CALL "SUB33" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
MOVE 44 TO SQLCODE
MOVE "x" TO SQLSTATE
MOVE 0 TO maxlon
MOVE 10 TO LONG1
MOVE 1 TO ii
PERFORM P50 UNTIL ii > 50
.
P173.
DISPLAY "INSERT INTO HU.HH VALUES (:LONG1) done ", loopct "
- " times"
DISPLAY "For values 10, 100, 1000, 10000, etc."
DISPLAY "The maximum value inserted was ", maxlon
if (SQLCODE NOT < 0) then
GO TO P174
END-IF
DISPLAY " before a negative SQLCODE was returned"
DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
DISPLAY "SQLSTATE should be '22003'; its value is ",
SQLSTATE
if (SQLSTATE NOT = "22003") then
MOVE 0 TO flag
END-IF
.
P174.
if (SQLCODE NOT < 0) then
DISPLAY "Exception not encountered. Pass by default."
END-IF
* EXEC SQL ROLLBACK WORK;
CALL "SUB34" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
*Subtest 0494a ends
*Subtest 0494b begins.
*If it will not compile, save error message
*and then delete the subtest with TEd "hooks".
*enlarge value in table FF to the max
DISPLAY " "
* EXEC SQL DELETE FROM HU.FF;
CALL "SUB35" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO HU.FF VALUES (99999);
CALL "SUB36" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
DISPLAY "Starting at value 99999, UPDATE to multiply by 10"
MOVE 1 TO ii
PERFORM P49 UNTIL ii > 50
.
P175.
DISPLAY "Column INTTEST was multiplied by 10 ", loopct "
- " times"
*We are now ready to select it back.
*select back that large value into a short
DISPLAY " "
MOVE 44 TO SQLCODE
MOVE "x" TO SQLSTATE
COMPUTE SMALL1 = -1
DISPLAY "SELECT INTTEST INTO :SMALL1 FROM HU.FF;"
* EXEC SQL SELECT INTTEST INTO :SMALL1 FROM HU.FF;
CALL "SUB37" USING SQLCODE SQLSTATE SMALL1
MOVE SQLCODE TO SQL-COD
if (SQLCODE = 0) then
DISPLAY
"The large value from HU.FF was selected as SMALLINT."
END-IF
DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
DISPLAY "SQLSTATE should be '22003'; its value is ",
SQLSTATE
if (SQLCODE NOT < 0 OR SQLSTATE NOT = "22003") then
MOVE 0 TO flag
END-IF
* EXEC SQL ROLLBACK WORK;
CALL "SUB38" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
*Subtest 0494b ends
* EXEC SQL ROLLBACK WORK;
CALL "SUB39" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
if ( flag = 1 ) then
DISPLAY " *** pass *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0494','pass','MCO');
CALL "SUB40" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " dml082.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0494','fail','MCO');
CALL "SUB41" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
.
P100.
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB42" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
******************** END TEST0494 ********************
******************** BEGIN TEST0505 *******************
MOVE 1 TO flag
DISPLAY " TEST0505 "
DISPLAY "SQLSTATE = 44000: with check option violation"
DISPLAY "Note: VALID implementation-defined subclass will
- " be"
DISPLAY " accepted instead of no-subclass value of 000
- " "
DISPLAY "Reference ANSI SQL-1992,"
DISPLAY " section 11.19 General Rule
- " #11a"
DISPLAY " - - - - - - - - - - - - - - - - - - -"
MOVE 44 TO SQLCODE
MOVE "x" TO SQLSTATE
DISPLAY "INSERT INTO FLATER.WCOV VALUES (0);"
DISPLAY " the CHECK clause is CHECK FLATER.WCOV.C1 > 0 "
* EXEC SQL INSERT INTO FLATER.WCOV VALUES (0);
CALL "SUB43" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
DISPLAY "SQLSTATE should be '44000'; its value is ",
SQLSTATE
PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
if (SQLCODE NOT < 0 OR NR-TAB NOT = "44000") then
MOVE 0 TO flag
END-IF
DISPLAY " "
MOVE 44 TO SQLCODE
MOVE "x" TO SQLSTATE
DISPLAY "INSERT INTO FLATER.WCOV VALUES (75);"
* EXEC SQL INSERT INTO FLATER.WCOV VALUES (75);
CALL "SUB44" 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
DISPLAY " "
MOVE 44 TO SQLCODE
MOVE "x" TO SQLSTATE
DISPLAY "UPDATE FLATER.WCOV SET C1 = -C1 WHERE C1 = 75;"
* EXEC SQL UPDATE FLATER.WCOV SET C1 = -C1 WHERE C1 = 75
* ;
CALL "SUB45" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
DISPLAY "SQLSTATE should be '44000'; its value is ",
SQLSTATE
PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
if (SQLCODE NOT < 0 OR NR-TAB NOT = "44000") then
MOVE 0 TO flag
END-IF
* EXEC SQL ROLLBACK WORK;
CALL "SUB46" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
if ( flag = 1 ) then
DISPLAY " *** pass *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0505','pass','MCO');
CALL "SUB47" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " dml082.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0505','fail','MCO');
CALL "SUB48" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB49" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
******************** END TEST0505 ********************
**** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0
STOP RUN.
* **** Procedures for PERFORM statements
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.
P50.
* EXEC SQL INSERT INTO HU.HH VALUES (:LONG1);
CALL "SUB50" USING SQLCODE SQLSTATE LONG1
MOVE SQLCODE TO SQL-COD
if (SQLCODE < 0) then
GO TO P173
END-IF
MOVE ii TO loopct
if (LONG1 > maxlon) then
MOVE LONG1 TO maxlon
END-IF
COMPUTE LONG1 = LONG1 * 10
ADD 1 TO ii
.
P49.
* EXEC SQL UPDATE HU.FF SET INTTEST = 10 * INTTEST;
CALL "SUB51" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
if (SQLCODE < 0) then
GO TO P175
END-IF
MOVE ii TO loopct
ADD 1 TO ii
.
¤ Dauer der Verarbeitung: 0.51 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.
|