| products/Sources/formale Sprachen/Cobol/Test-Suite/SQL M/ |
|
Quellcode-Bibliothek© Kompilation durch diese Firma[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]Datei: dml082.cob Sprache: Cobol |
|
||||||
|
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 - " #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.46 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.Bot Zugriff |
