* Standard COBOL (file "MPB010.SCO") calling SQL * procedures in file "MPB010.MCO".
**************************************************************** * * COMMENT SECTION * * DATE 1994/2/16 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. * * MPB010.SCO * WRITTEN BY: David W. Flater * TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE * * This program tests <grant statement> and <revoke statement> * in non-dynamic SQL. This is part B of a two-part * concurrency test. It must be run as HU after MPA010 is * run as FLATER. * * REFERENCES * FIPS PUB 127-2 14.1 Transitional SQL * ANSI SQL-1992 * ****************************************************************
MOVE"HU "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 * EXEC SQL ROLLBACK WORK; CALL"SUB2"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD if (uid NOT = uidx) then DISPLAY"ERROR: User ", uid " expected. User ", uidx "
- " connected" STOPRUN END-IF MOVE 0 TO errcnt
DISPLAY "SQL Test Suite, V6.0, Module COBOL, mpb010.sco" DISPLAY "59-byte ID" DISPLAY"TEd Version #" *date_time print ACCEPT TO-DAY FROMDATE ACCEPT THE-TIME FROMTIME DISPLAY"Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIME
DISPLAY"This is part B of a two-part test. It should be
- " started" DISPLAY"AFTER mpa010. Table TOKENS must exist in schema
- " HU."
*to debug program, set debug1 = 1 MOVE 0 TO debug1 MOVE 1000 TO maxfls MOVE 1 TO pauze MOVE 2 TO pauze2 *This is not a concurrency test. *Using TEd, increase variable pauze if there is MAYDAY message. MOVE 10 TO progno
******************** BEGIN TEST0627 ******************* MOVE 1 TO flag
DISPLAY"You should have already started Program A." MOVE 1 TO waitin
.
P194. if (debug1 NOT = 0) then DISPLAY"Debug trace: P194" END-IF if (waitin = -1) then GOTO P197 END-IF MOVE 0 TO fails COMPUTE oldtok = -1 DISPLAY"Waiting for the token to reach ", waitin "."
.
P104. if (debug1 NOT = 0) then DISPLAY"Debug trace: P104" END-IF COMPUTE int1 = -1 * EXEC SQL SELECT TOKEN_NO INTO :int1 FROM HU.TOKENS * WHERE PROG_NO = :progno; CALL"SUB3"USING SQLCODE SQLSTATE int1 progno MOVE SQLCODE TO SQL-COD if (SQLCODE < 0) then DISPLAY"SQLCODE = ", SQL-COD " SQLSTATE = ",
SQLSTATE END-IF if (SQLCODE NOT < 0 AND SQLCODE NOT = 100 AND int1 NOT = oldtok ) then DISPLAY"Token = ", int1 MOVE int1 TO oldtok MOVE 0 TO fails END-IF if (SQLCODE < 0 OR SQLCODE = 100 OR int1 NOT =
waitin) then *Waste time and try again PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (NORMSQ = "21000") then GOTO P198 END-IF COMPUTE fails = fails + 1 if (fails > maxfls) then GOTO P199 END-IF *TEd hook for fixing delays: 024 PERFORM SLEEEP THRU P133 * EXEC SQL ROLLBACK WORK; CALL"SUB4"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD GOTO P104 END-IF
*date_time print ACCEPT TO-DAY FROMDATE ACCEPT THE-TIME FROMTIME DISPLAY"Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIME
if (int1 = 1) then GOTO P196 END-IF if (int1 = 3) then GOTO P190 END-IF if (int1 = 5) then GOTO P189 END-IF GOTO P197
*token == 1
.
P196. if (debug1 NOT = 0) then DISPLAY"Debug trace: P196" END-IF DISPLAY"Program 'B' trying to access inaccessible table."
COMPUTE int1 = -1 DISPLAY"SELECT COUNT(*) INTO :int1 FROM FLATER.GRANT010;" * EXEC SQL SELECT COUNT(*) INTO :int1 FROM FLATER.GRANT010 * ; CALL"SUB5"USING SQLCODE SQLSTATE int1 MOVE SQLCODE TO SQL-COD DISPLAY"SQLCODE should be < 0; its value is ", SQL-COD DISPLAY"SQLSTATE should be 42000; its value is ", SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (SQLCODE NOT < 0 OR NORMSQ NOT = "42000") then MOVE 0 TO flag END-IF if (NORMSQ = "42000"AND NORMSQ NOT = SQLSTATE) then DISPLAY"Valid implementation-defined SQLSTATE accepted." END-IF DISPLAY" " DISPLAY"int1 should not be 1; its value is ", int1 if (int1 = 1) then MOVE 0 TO flag END-IF
DISPLAY"INSERT INTO FLATER.GRANT010 VALUES (0);" * EXEC SQL INSERT INTO FLATER.GRANT010 VALUES (0); CALL"SUB6"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD DISPLAY"SQLCODE should be < 0; its value is ", SQL-COD DISPLAY"SQLSTATE should be 42000; its value is ", SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (SQLCODE NOT < 0 OR NORMSQ NOT = "42000") then MOVE 0 TO flag END-IF if (NORMSQ = "42000"AND NORMSQ NOT = SQLSTATE) then DISPLAY"Valid implementation-defined SQLSTATE accepted." END-IF DISPLAY" "
DISPLAY"UPDATE FLATER.GRANT010 SET C1 = 0;" * EXEC SQL UPDATE FLATER.GRANT010 SET C1 = 0; CALL"SUB7"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD DISPLAY"SQLCODE should be < 0; its value is ", SQL-COD DISPLAY"SQLSTATE should be 42000; its value is ", SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (SQLCODE NOT < 0 OR NORMSQ NOT = "42000") then MOVE 0 TO flag END-IF if (NORMSQ = "42000"AND NORMSQ NOT = SQLSTATE) then DISPLAY"Valid implementation-defined SQLSTATE accepted." END-IF DISPLAY" "
DISPLAY"DELETE FROM FLATER.GRANT010;" * EXEC SQL DELETE FROM FLATER.GRANT010; CALL"SUB8"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD DISPLAY"SQLCODE should be < 0; its value is ", SQL-COD DISPLAY"SQLSTATE should be 42000; its value is ", SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (SQLCODE NOT < 0 OR NORMSQ NOT = "42000") then MOVE 0 TO flag END-IF if (NORMSQ = "42000"AND NORMSQ NOT = SQLSTATE) then DISPLAY"Valid implementation-defined SQLSTATE accepted." END-IF DISPLAY" "
*token == 3
.
P190. if (debug1 NOT = 0) then DISPLAY"Debug trace: P190" END-IF DISPLAY"Program 'B' trying to access select-only table."
COMPUTE int1 = -1 DISPLAY"SELECT COUNT(*) INTO :int1 FROM FLATER.GRANT010;" * EXEC SQL SELECT COUNT(*) INTO :int1 FROM FLATER.GRANT010 * ; CALL"SUB10"USING SQLCODE SQLSTATE int1 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 1; its value is ", int1 if (int1 NOT = 1) then MOVE 0 TO flag END-IF
DISPLAY"INSERT INTO FLATER.GRANT010 VALUES (0);" * EXEC SQL INSERT INTO FLATER.GRANT010 VALUES (0); CALL"SUB11"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD DISPLAY"SQLCODE should be < 0; its value is ", SQL-COD DISPLAY"SQLSTATE should be 42000; its value is ", SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (SQLCODE NOT < 0 OR NORMSQ NOT = "42000") then MOVE 0 TO flag END-IF if (NORMSQ = "42000"AND NORMSQ NOT = SQLSTATE) then DISPLAY"Valid implementation-defined SQLSTATE accepted." END-IF DISPLAY" "
DISPLAY"UPDATE FLATER.GRANT010 SET C1 = 0;" * EXEC SQL UPDATE FLATER.GRANT010 SET C1 = 0; CALL"SUB12"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD DISPLAY"SQLCODE should be < 0; its value is ", SQL-COD DISPLAY"SQLSTATE should be 42000; its value is ", SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (SQLCODE NOT < 0 OR NORMSQ NOT = "42000") then MOVE 0 TO flag END-IF if (NORMSQ = "42000"AND NORMSQ NOT = SQLSTATE) then DISPLAY"Valid implementation-defined SQLSTATE accepted." END-IF DISPLAY" "
DISPLAY"DELETE FROM FLATER.GRANT010;" * EXEC SQL DELETE FROM FLATER.GRANT010; CALL"SUB13"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD DISPLAY"SQLCODE should be < 0; its value is ", SQL-COD DISPLAY"SQLSTATE should be 42000; its value is ", SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (SQLCODE NOT < 0 OR NORMSQ NOT = "42000") then MOVE 0 TO flag END-IF if (NORMSQ = "42000"AND NORMSQ NOT = SQLSTATE) then DISPLAY"Valid implementation-defined SQLSTATE accepted." END-IF DISPLAY" "
*token == 5
.
P189. if (debug1 NOT = 0) then DISPLAY"Debug trace: P189" END-IF DISPLAY"Program 'B' trying to use all privileges."
COMPUTE int1 = -1 DISPLAY"SELECT COUNT(*) INTO :int1 FROM FLATER.GRANT010;" * EXEC SQL SELECT COUNT(*) INTO :int1 FROM FLATER.GRANT010 * ; CALL"SUB15"USING SQLCODE SQLSTATE int1 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 1; its value is ", int1 if (int1 NOT = 1) then MOVE 0 TO flag END-IF
DISPLAY"INSERT INTO FLATER.GRANT010 VALUES (0);" * EXEC SQL INSERT INTO FLATER.GRANT010 VALUES (0); CALL"SUB16"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"SELECT COUNT(*) INTO :int1 FROM FLATER.GRANT010;" * EXEC SQL SELECT COUNT(*) INTO :int1 FROM FLATER.GRANT010 * ; CALL"SUB17"USING SQLCODE SQLSTATE int1 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 2; its value is ", int1 if (int1 NOT = 2) then MOVE 0 TO flag END-IF
DISPLAY"UPDATE FLATER.GRANT010 SET C1 = 0;" * EXEC SQL UPDATE FLATER.GRANT010 SET C1 = 0; CALL"SUB18"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"SELECT COUNT(*) INTO :int1 FROM FLATER.GRANT010" DISPLAY" WHERE C1 = 0;" * EXEC SQL SELECT COUNT(*) INTO :int1 FROM FLATER.GRANT010 * WHERE C1 = 0; CALL"SUB19"USING SQLCODE SQLSTATE int1 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 2; its value is ", int1 if (int1 NOT = 2) then MOVE 0 TO flag END-IF
DISPLAY"DELETE FROM FLATER.GRANT010;" * EXEC SQL DELETE FROM FLATER.GRANT010; CALL"SUB20"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"SELECT COUNT(*) INTO :int1 FROM FLATER.GRANT010;" * EXEC SQL SELECT COUNT(*) INTO :int1 FROM FLATER.GRANT010 * ; CALL"SUB21"USING SQLCODE SQLSTATE int1 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 0; its value is ", int1 if (int1 NOT = 0) then MOVE 0 TO flag END-IF
DISPLAY"Program 'B' trying to use grant option (should
- " fail)."
DISPLAY"GRANT SELECT ON FLATER.GRANT010 TO SCHANZLE;" * EXEC SQL GRANT SELECT ON FLATER.GRANT010 TO SCHANZLE * ; CALL"SUB23"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD DISPLAY"SQLCODE should be >= 0; its value is ", SQL-COD DISPLAY"SQLSTATE should be 01007; its value is ", SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (SQLCODE < 0 OR NORMSQ NOT = "01007") then MOVE 0 TO flag END-IF
* EXEC SQL COMMIT WORK; CALL"SUB31"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD ******************** END TEST0627 ******************** ******************** BEGIN TEST0628 ******************* MOVE 1 TO flag
*date_time print ACCEPT TO-DAY FROMDATE ACCEPT THE-TIME FROMTIME DISPLAY"Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIME DISPLAY"You should have already started Program A." MOVE 1 TO waitin
.
P160. if (debug1 NOT = 0) then DISPLAY"Debug trace: P160" END-IF if (waitin = -1) then GOTO P163 END-IF MOVE 0 TO fails COMPUTE oldtok = -1 DISPLAY"Waiting for the token to reach ", waitin "."
.
P161. if (debug1 NOT = 0) then DISPLAY"Debug trace: P161" END-IF COMPUTE int1 = -1 * EXEC SQL SELECT TOKEN_NO INTO :int1 FROM HU.TOKENS * WHERE PROG_NO = :progno; CALL"SUB32"USING SQLCODE SQLSTATE int1 progno MOVE SQLCODE TO SQL-COD if (SQLCODE < 0) then DISPLAY"SQLCODE = ", SQL-COD " SQLSTATE = ",
SQLSTATE END-IF if (SQLCODE NOT < 0 AND SQLCODE NOT = 100 AND int1 NOT = oldtok ) then DISPLAY"Token = ", int1 MOVE int1 TO oldtok MOVE 0 TO fails END-IF if (SQLCODE < 0 OR SQLCODE = 100 OR int1 NOT =
waitin) then *Waste time and try again PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (NORMSQ = "21000") then GOTO P198 END-IF COMPUTE fails = fails + 1 if (fails > maxfls) then GOTO P199 END-IF *TEd hook for fixing delays: 027 PERFORM SLEEEP THRU P133 * EXEC SQL ROLLBACK WORK; CALL"SUB33"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD GOTO P161 END-IF
*date_time print ACCEPT TO-DAY FROMDATE ACCEPT THE-TIME FROMTIME DISPLAY"Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIME
if (int1 = 1) then GOTO P162 END-IF if (int1 = 3) then GOTO P170 END-IF GOTO P163
*token == 1
.
P162. if (debug1 NOT = 0) then DISPLAY"Debug trace: P162" END-IF DISPLAY"Program 'B' trying to access insert-only table."
DISPLAY"SELECT COUNT(*) INTO :int1 FROM FLATER.GRANT010;" * EXEC SQL SELECT COUNT(*) INTO :int1 FROM FLATER.GRANT010 * ; CALL"SUB34"USING SQLCODE SQLSTATE int1 MOVE SQLCODE TO SQL-COD DISPLAY"SQLCODE should be < 0; its value is ", SQL-COD DISPLAY"SQLSTATE should be 42000; its value is ", SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (SQLCODE NOT < 0 OR NORMSQ NOT = "42000") then MOVE 0 TO flag END-IF if (NORMSQ = "42000"AND NORMSQ NOT = SQLSTATE) then DISPLAY"Valid implementation-defined SQLSTATE accepted." END-IF DISPLAY" "
DISPLAY"INSERT INTO FLATER.GRANT010 VALUES (0);" * EXEC SQL INSERT INTO FLATER.GRANT010 VALUES (0); CALL"SUB35"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
DISPLAY"UPDATE FLATER.GRANT010 SET C1 = 0;" * EXEC SQL UPDATE FLATER.GRANT010 SET C1 = 0; CALL"SUB36"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD DISPLAY"SQLCODE should be < 0; its value is ", SQL-COD DISPLAY"SQLSTATE should be 42000; its value is ", SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (SQLCODE NOT < 0 OR NORMSQ NOT = "42000") then MOVE 0 TO flag END-IF if (NORMSQ = "42000"AND NORMSQ NOT = SQLSTATE) then DISPLAY"Valid implementation-defined SQLSTATE accepted." END-IF DISPLAY" "
DISPLAY"DELETE FROM FLATER.GRANT010;" * EXEC SQL DELETE FROM FLATER.GRANT010; CALL"SUB37"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD DISPLAY"SQLCODE should be < 0; its value is ", SQL-COD DISPLAY"SQLSTATE should be 42000; its value is ", SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (SQLCODE NOT < 0 OR NORMSQ NOT = "42000") then MOVE 0 TO flag END-IF if (NORMSQ = "42000"AND NORMSQ NOT = SQLSTATE) then DISPLAY"Valid implementation-defined SQLSTATE accepted." END-IF DISPLAY" "
*token == 3
.
P170. if (debug1 NOT = 0) then DISPLAY"Debug trace: P170" END-IF DISPLAY"Program 'B' trying to access inaccessible table."
DISPLAY"SELECT COUNT(*) INTO :int1 FROM FLATER.GRANT010;" * EXEC SQL SELECT COUNT(*) INTO :int1 FROM FLATER.GRANT010 * ; CALL"SUB39"USING SQLCODE SQLSTATE int1 MOVE SQLCODE TO SQL-COD DISPLAY"SQLCODE should be < 0; its value is ", SQL-COD DISPLAY"SQLSTATE should be 42000; its value is ", SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (SQLCODE NOT < 0 OR NORMSQ NOT = "42000") then MOVE 0 TO flag END-IF if (NORMSQ = "42000"AND NORMSQ NOT = SQLSTATE) then DISPLAY"Valid implementation-defined SQLSTATE accepted." END-IF DISPLAY" "
DISPLAY"INSERT INTO FLATER.GRANT010 VALUES (0);" * EXEC SQL INSERT INTO FLATER.GRANT010 VALUES (0); CALL"SUB40"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD DISPLAY"SQLCODE should be < 0; its value is ", SQL-COD DISPLAY"SQLSTATE should be 42000; its value is ", SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (SQLCODE NOT < 0 OR NORMSQ NOT = "42000") then MOVE 0 TO flag END-IF if (NORMSQ = "42000"AND NORMSQ NOT = SQLSTATE) then DISPLAY"Valid implementation-defined SQLSTATE accepted." END-IF DISPLAY" "
DISPLAY"UPDATE FLATER.GRANT010 SET C1 = 0;" * EXEC SQL UPDATE FLATER.GRANT010 SET C1 = 0; CALL"SUB41"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD DISPLAY"SQLCODE should be < 0; its value is ", SQL-COD DISPLAY"SQLSTATE should be 42000; its value is ", SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (SQLCODE NOT < 0 OR NORMSQ NOT = "42000") then MOVE 0 TO flag END-IF if (NORMSQ = "42000"AND NORMSQ NOT = SQLSTATE) then DISPLAY"Valid implementation-defined SQLSTATE accepted." END-IF DISPLAY" "
DISPLAY"DELETE FROM FLATER.GRANT010;" * EXEC SQL DELETE FROM FLATER.GRANT010; CALL"SUB42"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD DISPLAY"SQLCODE should be < 0; its value is ", SQL-COD DISPLAY"SQLSTATE should be 42000; its value is ", SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (SQLCODE NOT < 0 OR NORMSQ NOT = "42000") then MOVE 0 TO flag END-IF if (NORMSQ = "42000"AND NORMSQ NOT = SQLSTATE) then DISPLAY"Valid implementation-defined SQLSTATE accepted." END-IF DISPLAY" "
* EXEC SQL COMMIT WORK; CALL"SUB50"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD ******************** END TEST0628 ******************** ******************** BEGIN TEST0560 ******************* MOVE 1 TO flag
*date_time print ACCEPT TO-DAY FROMDATE ACCEPT THE-TIME FROMTIME DISPLAY"Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIME DISPLAY"You should have already started Program A." MOVE 1 TO waitin
MOVE 0 TO fails COMPUTE oldtok = -1 DISPLAY"Waiting for the token to reach ", waitin "."
.
P151. if (debug1 NOT = 0) then DISPLAY"Debug trace: P151" END-IF COMPUTE int1 = -1 * EXEC SQL SELECT TOKEN_NO INTO :int1 FROM HU.TOKENS * WHERE PROG_NO = :progno; CALL"SUB51"USING SQLCODE SQLSTATE int1 progno MOVE SQLCODE TO SQL-COD if (SQLCODE < 0) then DISPLAY"SQLCODE = ", SQL-COD " SQLSTATE = ",
SQLSTATE END-IF if (SQLCODE NOT < 0 AND SQLCODE NOT = 100 AND int1 NOT = oldtok ) then DISPLAY"Token = ", int1 MOVE int1 TO oldtok MOVE 0 TO fails END-IF if (SQLCODE < 0 OR SQLCODE = 100 OR int1 NOT =
waitin) then *Waste time and try again PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (NORMSQ = "21000") then GOTO P198 END-IF COMPUTE fails = fails + 1 if (fails > maxfls * maxfls) then GOTO P199 END-IF *TEd hook for fixing delays: 030 PERFORM SLEEEP THRU P133 * EXEC SQL ROLLBACK WORK; CALL"SUB52"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD GOTO P151 END-IF
MOVE 0 TO fails *date_time print ACCEPT TO-DAY FROMDATE ACCEPT THE-TIME FROMTIME DISPLAY"Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIME
*token == 1 DISPLAY"Program 'B' testing access to FLATER.X"
DISPLAY"UPDATE FLATER.X SET A = 0;" * EXEC SQL UPDATE FLATER.X SET A = 0; CALL"SUB53"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
DISPLAY"UPDATE FLATER.X SET B = 0;" * EXEC SQL UPDATE FLATER.X SET B = 0; CALL"SUB54"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD DISPLAY"SQLCODE should be < 0; its value is ", SQL-COD DISPLAY"SQLSTATE should be 42000; its value is ", SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (SQLCODE NOT < 0 OR NORMSQ NOT = "42000") then MOVE 0 TO flag END-IF if (NORMSQ = "42000"AND NORMSQ NOT = SQLSTATE) then DISPLAY"Valid implementation-defined SQLSTATE accepted." END-IF DISPLAY" "
DISPLAY"UPDATE FLATER.X SET C = 0;" * EXEC SQL UPDATE FLATER.X SET C = 0; CALL"SUB55"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
DISPLAY"UPDATE FLATER.X SET D = 0;" * EXEC SQL UPDATE FLATER.X SET D = 0; CALL"SUB56"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"SELECT COUNT(*) INTO :int1 FROM FLATER.X" DISPLAY" WHERE A = 0 AND B = 2 AND C = 0 AND D = 0;" * EXEC SQL SELECT COUNT(*) INTO :int1 FROM FLATER.X * WHERE A = 0 AND B = 2 AND C = 0 AND D = 0; CALL"SUB57"USING SQLCODE SQLSTATE int1 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 1; its value is ", int1 if (int1 NOT = 1) then MOVE 0 TO flag END-IF
* EXEC SQL COMMIT WORK; CALL"SUB65"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD ******************** END TEST0560 ******************** STOPRUN.
P198. if (debug1 NOT = 0) then DISPLAY"Debug trace: P198" END-IF DISPLAY"CARDINALITY VIOLATION"
.
P199. if (debug1 NOT = 0) then DISPLAY"Debug trace: P199" END-IF if (fails > maxfls) then DISPLAY"The number of attempts (fails) exceeds variable
- " maxfls." DISPLAY"Increase the value of variable maxfls, if
- " needed." DISPLAY"Or, increase the value of variable pauze." END-IF DISPLAY"MAYDAY MAYDAY PROGRAM ABORTING" DISPLAY"You will have to start this test over." STOPRUN.
* **** Procedures for PERFORM statements
*Test SQLCODE and SQLSTATE for normal completion.
CHCKOK. 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 NORMSQ NOT = "00000") then MOVE 0 TO flag END-IF if (NORMSQ = "00000"AND NORMSQ NOT = SQLSTATE) then DISPLAY"Valid implementation-defined SQLSTATE accepted." END-IF
.
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 NORMSQ
MOVE 3 TO norm1 *subclass begins in position 3 of char array NORMSQ *valid subclass begins with 5-9, I-Z, end of ALPNUM table PERFORMVARYING norm2 FROM 14 BY 1 UNTIL norm2 > 36 if (NORMSQX(norm1) = ALPNUM(norm2)) then MOVE"0"TO NORMSQX(norm1) END-IF END-PERFORM
*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) if (NORMSQ = SQLSTATE) then GOTO EXIT-NOSUBCLASS END-IF
MOVE 4 TO norm1 *examining position 4 of char array NORMSQ *valid characters are 0-9, A-Z PERFORMVARYING norm2 FROM 1 BY 1 UNTIL norm2 > 36 if (NORMSQX(norm1) = ALPNUM(norm2)) then MOVE"0"TO NORMSQX(norm1) END-IF END-PERFORM
MOVE 5 TO norm1 *valid characters are 0-9, A-Z *examining position 5 of char array NORMSQ PERFORMVARYING norm2 FROM 1 BY 1 UNTIL norm2 > 36 if (NORMSQX(norm1) = ALPNUM(norm2)) then MOVE"0"TO NORMSQX(norm1) END-IF END-PERFORM
*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 (NORMSQX(1) = "0"AND NORMSQX(2) = "1") then MOVE"0"TO NORMSQX(2) END-IF
.
EXIT-NOSUBCLASS. EXIT.
SLEEEP. COMPUTE repcnt = fails * pauze if (repcnt > 17) then COMPUTE repcnt = repcnt * repcnt + pauze2 END-IF MOVE 1 TO iii
.
P133. * EXEC SQL COMMIT WORK; CALL"SUB66"USING SQLCODE SQLSTATE COMPUTE int1 = -1 * EXEC SQL UPDATE HU.WORKS * SET HOURS = -1 WHERE HOURS = :int1; CALL"SUB67"USING SQLCODE SQLSTATE int1 COMPUTE iii = iii + 1 if (iii < repcnt) then GOTO P133 END-IF
.
¤ Dauer der Verarbeitung: 0.26 Sekunden
(vorverarbeitet)
¤
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.