IDENTIFICATION DIVISION .PROGRAM-ID . MPB012.ENVIRONMENT DIVISION .CONFIGURATION SECTION .SOURCE-COMPUTER . xyz.OBJECT-COMPUTER . xyz.DATA DIVISION .WORKING-STORAGE SECTION . * Standard COBOL (file "MPB012.SCO") calling SQL * procedures in file "MPB012.MCO". **************************************************************** * * COMMENT SECTION * * DATE 1995/03/28 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. * * MPB012.SCO * WRITTEN BY: David W. Flater * TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE * * This routine tests SET TRANSACTION ISOLATION LEVEL for * dynamic SQL. This is part B of a two-part program. * * References: * FIPS PUB 127-2 14.1 Transitional SQL * ANSI SQL-1992 14.1 <set transaction statement> * **************************************************************** * EXEC SQL BEGIN DECLARE SECTION END-EXEC 01 uid PIC X(18 ).01 uidx PIC X(18 ).01 SQLCODE PIC S9(9 ) COMP .01 SQLSTATE PIC X(5 ).01 int1 PIC S9(9 ) DISPLAY SIGN LEADING SEPARATE .01 int2 PIC S9(9 ) DISPLAY SIGN LEADING SEPARATE .01 int3 PIC S9(9 ) DISPLAY SIGN LEADING SEPARATE .01 dstmt PIC X(50 ).01 longst PIC X(240 ).01 progno PIC S9(9 ) DISPLAY SIGN LEADING SEPARATE . * EXEC SQL END DECLARE SECTION END-EXEC 01 PLEN PIC S9(9 ) DISPLAY SIGN LEADING SEPARATE .01 SQLCD1 PIC S9(9 ) DISPLAY SIGN LEADING SEPARATE .01 pauze PIC S9(9 ) DISPLAY SIGN LEADING SEPARATE .01 repcnt PIC S9(9 ) DISPLAY SIGN LEADING SEPARATE .01 iii PIC S9(9 ) DISPLAY SIGN LEADING SEPARATE .01 fails PIC S9(9 ) DISPLAY SIGN LEADING SEPARATE .01 maxfls PIC S9(9 ) DISPLAY SIGN LEADING SEPARATE .01 oldtok PIC S9(9 ) DISPLAY SIGN LEADING SEPARATE .01 waitin PIC S9(9 ) DISPLAY SIGN LEADING SEPARATE .01 norm1 PIC S9(9 ) DISPLAY SIGN LEADING SEPARATE .01 norm2 PIC S9(9 ) DISPLAY SIGN LEADING SEPARATE .01 ALPNUM-TABLE VALUE IS "01234ABCDEFGH56789IJKLMNOPQRSTUVWXYZ" .05 ALPNUM PIC X OCCURS 36 TIMES.01 NORMSQ.05 NORMSQX PIC X OCCURS 5 TIMES.01 errcnt PIC S9(9 ) DISPLAY SIGN LEADING SEPARATE . * Debugging is turned on by setting debug1 = 1 01 debug1 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 .MOVE "SULLIVAN1 " TO uidCALL "AUTHID" USING uidMOVE "not logged in, not" TO uidx * EXEC SQL SELECT USER INTO :uidx FROM HU.ECCO; CALL "SUB1" USING SQLCODE SQLSTATE uidxMOVE SQLCODE TO SQL-COD * EXEC SQL ROLLBACK WORK; CALL "SUB2" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODif (uid NOT = uidx) then DISPLAY "ERROR: User " , uid, " expected. User " , uidx, " " connected" STOP RUN END-IF MOVE 0 TO errcntDISPLAY "SQL Test Suite, V6.0, Module COBOL, mpb012.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-TIMEDISPLAY "This is part B of a two-part test. It should be " started" DISPLAY "AFTER mpa012. Table TOKENS must exist in schema " HU." *to debug program, set debug1 = 1 MOVE 0 TO debug1MOVE 100 TO maxflsMOVE 100 TO pauzeMOVE 12 TO progno ******************** BEGIN TEST0590 ******************* MOVE 1 TO flag *SQL-92 14.1 GR.5 says that a transaction at a particular *isolation level must not exhibit phenomena which are not *supposed to be possible at that level, but does not *require transactions to exhibit those phenomena which *are possible. A conforming implementation could simply *ignore all SET TRANSACTION ISOLATION LEVEL statements *and treat all transactions as SERIALIZABLE. The *phenomena are defined in SQL-92 4.28. DISPLAY " TEST0590 " DISPLAY " SET TR ISOLATION LEVEL (dynamic)" DISPLAY "Reference:" DISPLAY " F# 11 -- Transaction Isolation" DISPLAY " F# 1 -- Dynamic SQL" DISPLAY " 14.1 -- <set transaction statement>" DISPLAY " 4.28 -- SQL-transactions" DISPLAY " - - - - - - - - - - - - - - - - - - -" COMPUTE SQLCODE = -1 MOVE "xxxxx" TO SQLSTATEMOVE 1 TO waitinMOVE 0 TO failsCOMPUTE oldtok = -1 DISPLAY "Waiting for the token to reach " , waitin, "." if (debug1 NOT = 0 ) then DISPLAY "Debug trace: P165" 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 prognoMOVE SQLCODE TO SQL-CODif (SQLCODE < 0 ) then DISPLAY "SQLCODE = " , SQL-COD, " SQLSTATE = '" ,"'" END-IF if (int1 NOT = oldtok AND SQLCODE NOT < 0 AND SQLCODE NOT = 100 ) then DISPLAY "Token = " , int1MOVE int1 TO oldtokMOVE 0 TO failsEND-IF if (SQLCODE < 0 OR int1 NOT = waitin) then *Waste time and try again PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASSif (NORMSQ = "21000" ) then GO TO P198END-IF COMPUTE fails = fails + 1 if (fails > maxfls) then GO TO P199END-IF *TEd hook for fixing delays: 014 * EXEC SQL ROLLBACK WORK; CALL "SUB4" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODMOVE 2 TO PLENPERFORM SLEEEP THRU P333 * EXEC SQL ROLLBACK WORK; CALL "SUB5" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODGO TO P165END-IF *The token is exchanged up front to synchronize, then the two *programs try to run concurrently. MOVE 0 TO fails *date_time print ACCEPT TO-DAY FROM DATE ACCEPT THE-TIME FROM TIME DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIMEDISPLAY "Passing token to 'A' and running concurrently...." if (debug1 NOT = 0 ) then DISPLAY "Debug trace: P169" END-IF * EXEC SQL UPDATE HU.TOKENS SET TOKEN_NO = TOKEN_NO + 1 * WHERE PROG_NO = :progno; CALL "SUB6" USING SQLCODE SQLSTATE prognoMOVE SQLCODE TO SQL-CODif (SQLCODE < 0 ) then *Waste time and try again DISPLAY "SQLCODE = " , SQL-COD, " SQLSTATE = '" ,"'" COMPUTE fails = fails + 1 if (fails > maxfls) then GO TO P199END-IF *TEd hook for fixing delays: 015 * EXEC SQL ROLLBACK WORK; CALL "SUB7" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODMOVE 1 TO PLENPERFORM SLEEEP THRU P333 * EXEC SQL ROLLBACK WORK; CALL "SUB8" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODGO TO P169END-IF * EXEC SQL COMMIT WORK; CALL "SUB9" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODif (SQLCODE < 0 ) then *Waste time and try again DISPLAY "SQLCODE = " , SQL-COD, " SQLSTATE = '" ,"'" COMPUTE fails = fails + 1 if (fails > maxfls) then GO TO P199END-IF *TEd hook for fixing delays: 016 * EXEC SQL ROLLBACK WORK; CALL "SUB10" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODMOVE 1 TO PLENPERFORM SLEEEP THRU P333 * EXEC SQL ROLLBACK WORK; CALL "SUB11" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODGO TO P169END-IF *date_time print ACCEPT TO-DAY FROM DATE ACCEPT THE-TIME FROM TIME DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIME *Try to generate dirty read. if (debug1 NOT = 0 ) then DISPLAY "Debug trace: P131" END-IF DISPLAY "dstmt=" "INSERT INTO USG103 VALUES (589, 985)" "" MOVE "INSERT INTO USG103 VALUES (589, 985) " TO dstmtDISPLAY "EXECUTE IMMEDIATE :dstmt;" * EXEC SQL EXECUTE IMMEDIATE :dstmt; CALL "SUB12" USING SQLCODE SQLSTATE dstmtMOVE SQLCODE TO SQL-CODDISPLAY "SQLCODE is " , SQL-CODDISPLAY "'A' should try to read 589, 985 now." DISPLAY "Begin SLEEEP (10)" *date_time print ACCEPT TO-DAY FROM DATE ACCEPT THE-TIME FROM TIME DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIMEMOVE 10 TO PLENPERFORM SLEEEP THRU P333DISPLAY "End SLEEEP (10)" *date_time print ACCEPT TO-DAY FROM DATE ACCEPT THE-TIME FROM TIME DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIMEDISPLAY "dstmt=" "DELETE FROM USG103 WHERE C_1 = 985" "" MOVE "DELETE FROM USG103 WHERE C_1 = 985 " TO dstmtDISPLAY "EXECUTE IMMEDIATE :dstmt;" * EXEC SQL EXECUTE IMMEDIATE :dstmt; CALL "SUB13" USING SQLCODE SQLSTATE dstmtMOVE SQLCODE TO SQL-CODDISPLAY "SQLCODE is " , SQL-CODMOVE SQLCODE TO SQLCD1DISPLAY "Committing transaction...." * EXEC SQL COMMIT WORK; CALL "SUB14" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODif (SQLCODE < 0 OR SQLCD1 < 0 ) then DISPLAY "SQLCODE is " , SQL-COD, " -- Transaction voided." * EXEC SQL ROLLBACK WORK; CALL "SUB15" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODCOMPUTE fails = fails + 1 if (fails > maxfls) then GO TO P199END-IF GO TO P131END-IF MOVE 3 TO waitinMOVE 0 TO failsCOMPUTE oldtok = -1 DISPLAY "Waiting for the token to reach " , waitin, "." if (debug1 NOT = 0 ) then DISPLAY "Debug trace: P167" END-IF COMPUTE int1 = -1 * EXEC SQL SELECT TOKEN_NO INTO :int1 FROM HU.TOKENS * WHERE PROG_NO = :progno; CALL "SUB16" USING SQLCODE SQLSTATE int1 prognoMOVE SQLCODE TO SQL-CODif (SQLCODE < 0 ) then DISPLAY "SQLCODE = " , SQL-COD, " SQLSTATE = '" ,"'" END-IF if (int1 NOT = oldtok AND SQLCODE NOT < 0 AND SQLCODE NOT = 100 ) then DISPLAY "Token = " , int1MOVE int1 TO oldtokMOVE 0 TO failsEND-IF if (SQLCODE < 0 OR int1 NOT = waitin) then *Waste time and try again PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASSif (NORMSQ = "21000" ) then GO TO P198END-IF COMPUTE fails = fails + 1 if (fails > maxfls) then GO TO P199END-IF *TEd hook for fixing delays: 017 * EXEC SQL ROLLBACK WORK; CALL "SUB17" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODMOVE 2 TO PLENPERFORM SLEEEP THRU P333 * EXEC SQL ROLLBACK WORK; CALL "SUB18" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODGO TO P167END-IF *The token is exchanged up front to synchronize, then the two *programs try to run concurrently. MOVE 0 TO fails *date_time print ACCEPT TO-DAY FROM DATE ACCEPT THE-TIME FROM TIME DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIMEDISPLAY "Passing token to 'A' and running concurrently...." if (debug1 NOT = 0 ) then DISPLAY "Debug trace: P170" END-IF * EXEC SQL UPDATE HU.TOKENS SET TOKEN_NO = TOKEN_NO + 1 * WHERE PROG_NO = :progno; CALL "SUB19" USING SQLCODE SQLSTATE prognoMOVE SQLCODE TO SQL-CODif (SQLCODE < 0 ) then *Waste time and try again DISPLAY "SQLCODE = " , SQL-COD, " SQLSTATE = '" ,"'" COMPUTE fails = fails + 1 if (fails > maxfls) then GO TO P199END-IF *TEd hook for fixing delays: 018 * EXEC SQL ROLLBACK WORK; CALL "SUB20" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODMOVE 1 TO PLENPERFORM SLEEEP THRU P333 * EXEC SQL ROLLBACK WORK; CALL "SUB21" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODGO TO P170END-IF * EXEC SQL COMMIT WORK; CALL "SUB22" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODif (SQLCODE < 0 ) then *Waste time and try again DISPLAY "SQLCODE = " , SQL-COD, " SQLSTATE = '" ,"'" COMPUTE fails = fails + 1 if (fails > maxfls) then GO TO P199END-IF *TEd hook for fixing delays: 019 * EXEC SQL ROLLBACK WORK; CALL "SUB23" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODMOVE 1 TO PLENPERFORM SLEEEP THRU P333 * EXEC SQL ROLLBACK WORK; CALL "SUB24" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODGO TO P170END-IF *date_time print ACCEPT TO-DAY FROM DATE ACCEPT THE-TIME FROM TIME DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIME *Try to generate a non-repeatable read. if (debug1 NOT = 0 ) then DISPLAY "Debug trace: P132" END-IF DISPLAY "'A' should do a read now." DISPLAY "Begin SLEEEP (10)" *date_time print ACCEPT TO-DAY FROM DATE ACCEPT THE-TIME FROM TIME DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIMEMOVE 10 TO PLENPERFORM SLEEEP THRU P333DISPLAY "End SLEEEP (10)" *date_time print ACCEPT TO-DAY FROM DATE ACCEPT THE-TIME FROM TIME DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIMEDISPLAY "dstmt=" "UPDATE USG103 SET C_1 = 1000 WHERE C_1 = " 600" "" MOVE "UPDATE USG103 SET C_1 = 1000 WHERE C_1 = 600 " TO dstmtDISPLAY "EXECUTE IMMEDIATE :dstmt;" * EXEC SQL EXECUTE IMMEDIATE :dstmt; CALL "SUB25" USING SQLCODE SQLSTATE dstmtMOVE SQLCODE TO SQL-CODMOVE SQLCODE TO SQLCD1DISPLAY "SQLCODE is " , SQL-CODDISPLAY "'A' can do another read now." DISPLAY "Committing transaction...." * EXEC SQL COMMIT WORK; CALL "SUB26" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODif (SQLCODE < 0 OR SQLCD1 < 0 ) then DISPLAY "SQLCODE is " , SQL-COD, " -- Transaction voided." * EXEC SQL ROLLBACK WORK; CALL "SUB27" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODCOMPUTE fails = fails + 1 if (fails > maxfls) then GO TO P199END-IF if (fails > 3 ) then MOVE 20 TO PLENPERFORM SLEEEP THRU P333END-IF GO TO P132END-IF MOVE 5 TO waitinMOVE 0 TO failsCOMPUTE oldtok = -1 DISPLAY "Waiting for the token to reach " , waitin, "." if (debug1 NOT = 0 ) then DISPLAY "Debug trace: P171" END-IF COMPUTE int1 = -1 * EXEC SQL SELECT TOKEN_NO INTO :int1 FROM HU.TOKENS * WHERE PROG_NO = :progno; CALL "SUB28" USING SQLCODE SQLSTATE int1 prognoMOVE SQLCODE TO SQL-CODif (SQLCODE < 0 ) then DISPLAY "SQLCODE = " , SQL-COD, " SQLSTATE = '" ,"'" END-IF if (int1 NOT = oldtok AND SQLCODE NOT < 0 AND SQLCODE NOT = 100 ) then DISPLAY "Token = " , int1MOVE int1 TO oldtokMOVE 0 TO failsEND-IF if (SQLCODE < 0 OR int1 NOT = waitin) then *Waste time and try again PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASSif (NORMSQ = "21000" ) then GO TO P198END-IF COMPUTE fails = fails + 1 if (fails > maxfls) then GO TO P199END-IF *TEd hook for fixing delays: 030 * EXEC SQL ROLLBACK WORK; CALL "SUB29" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODMOVE 2 TO PLENPERFORM SLEEEP THRU P333 * EXEC SQL ROLLBACK WORK; CALL "SUB30" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODGO TO P171END-IF *The token is exchanged up front to synchronize, then the two *programs try to run concurrently. MOVE 0 TO fails *date_time print ACCEPT TO-DAY FROM DATE ACCEPT THE-TIME FROM TIME DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIMEDISPLAY "Passing token to 'A' and running concurrently...." if (debug1 NOT = 0 ) then DISPLAY "Debug trace: P172" END-IF * EXEC SQL UPDATE HU.TOKENS SET TOKEN_NO = TOKEN_NO + 1 * WHERE PROG_NO = :progno; CALL "SUB31" USING SQLCODE SQLSTATE prognoMOVE SQLCODE TO SQL-CODif (SQLCODE < 0 ) then *Waste time and try again DISPLAY "SQLCODE = " , SQL-COD, " SQLSTATE = '" ,"'" COMPUTE fails = fails + 1 if (fails > maxfls) then GO TO P199END-IF *TEd hook for fixing delays: 031 * EXEC SQL ROLLBACK WORK; CALL "SUB32" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODMOVE 1 TO PLENPERFORM SLEEEP THRU P333 * EXEC SQL ROLLBACK WORK; CALL "SUB33" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODGO TO P172END-IF * EXEC SQL COMMIT WORK; CALL "SUB34" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODif (SQLCODE < 0 ) then *Waste time and try again DISPLAY "SQLCODE = " , SQL-COD, " SQLSTATE = '" ,"'" COMPUTE fails = fails + 1 if (fails > maxfls) then GO TO P199END-IF *TEd hook for fixing delays: 032 * EXEC SQL ROLLBACK WORK; CALL "SUB35" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODMOVE 1 TO PLENPERFORM SLEEEP THRU P333 * EXEC SQL ROLLBACK WORK; CALL "SUB36" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODGO TO P172END-IF *date_time print ACCEPT TO-DAY FROM DATE ACCEPT THE-TIME FROM TIME DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIME *Try to generate a phantom read. if (debug1 NOT = 0 ) then DISPLAY "Debug trace: P133" END-IF DISPLAY "'A' should select count now." DISPLAY "Begin SLEEEP (10)" *date_time print ACCEPT TO-DAY FROM DATE ACCEPT THE-TIME FROM TIME DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIMEMOVE 10 TO PLENPERFORM SLEEEP THRU P333DISPLAY "End SLEEEP (10)" *date_time print ACCEPT TO-DAY FROM DATE ACCEPT THE-TIME FROM TIME DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIMEDISPLAY "dstmt=" "INSERT INTO USG103 VALUES (589, 5555)" "" MOVE "INSERT INTO USG103 VALUES (589, 5555) " TO dstmtDISPLAY "PREPARE S1031 FROM :dstmt;" * EXEC SQL PREPARE S1031 FROM :dstmt; CALL "SUB37" USING SQLCODE SQLSTATE dstmtMOVE SQLCODE TO SQL-CODif (SQLCODE < 0 ) then DISPLAY "Failure on PREPARE = failure on test" MOVE 0 TO flagGO TO P150END-IF DISPLAY "EXECUTE S1031;" * EXEC SQL EXECUTE S1031; CALL "SUB38" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODMOVE SQLCODE TO SQLCD1DISPLAY "SQLCODE is " , SQL-CODDISPLAY "'A' should select count again now." DISPLAY "Committing transaction...." * EXEC SQL COMMIT WORK; CALL "SUB39" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODif (SQLCODE < 0 OR SQLCD1 < 0 ) then DISPLAY "SQLCODE is " , SQL-COD, " -- Transaction voided." * EXEC SQL ROLLBACK WORK; CALL "SUB40" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODCOMPUTE fails = fails + 1 if (fails > maxfls) then GO TO P199END-IF if (fails > 3 ) then MOVE 20 TO PLENPERFORM SLEEEP THRU P333END-IF GO TO P133END-IF if (debug1 NOT = 0 ) then DISPLAY "Debug trace: P150" END-IF * EXEC SQL ROLLBACK WORK; CALL "SUB41" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODif ( flag = 1 ) then DISPLAY " *** pass *** " * EXEC SQL INSERT INTO HU.TESTREPORT * VALUES('0590','pass','MCO'); CALL "SUB42" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODelse DISPLAY " mpb012.sco *** fail *** " * EXEC SQL INSERT INTO HU.TESTREPORT * VALUES('0590','fail','MCO'); CALL "SUB43" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODCOMPUTE errcnt = errcnt + 1 END-IF * EXEC SQL COMMIT WORK; CALL "SUB44" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODDISPLAY "===============================================" ******************** END TEST0590 ******************** STOP RUN .if (debug1 NOT = 0 ) then DISPLAY "Debug trace: P198" END-IF DISPLAY "CARDINALITY VIOLATION" * EXEC SQL ROLLBACK WORK; CALL "SUB45" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODif (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." DISPLAY "Trying to kill token (no retries)...." * EXEC SQL DELETE FROM HU.TOKENS WHERE PROG_NO = :progno * ; CALL "SUB46" USING SQLCODE SQLSTATE prognoMOVE SQLCODE TO SQL-COD * EXEC SQL COMMIT WORK; CALL "SUB47" USING SQLCODE SQLSTATEMOVE SQLCODE TO SQL-CODSTOP RUN . * **** Procedures for PERFORM statements *TEd hook to replace SLEEEP routine #1 COMPUTE repcnt = pauze * plenMOVE 1 TO iiiCOMPUTE int3 = -1 * EXEC SQL UPDATE HU.STAFF * SET GRADE = -1 WHERE GRADE = :int3; CALL "SUB48" USING SQLCODE SQLSTATE int3MOVE SQLCODE TO SQL-CODCOMPUTE iii = iii + 1 if (iii < repcnt) then GO TO P333END-IF *TEd hook to replace SLEEEP routine #2 *Test SQLCODE and SQLSTATE for normal completion. DISPLAY "SQLCODE should be 0; its value is " , SQL-CODDISPLAY "SQLSTATE should be 00000; its value is " , SQLSTATEPERFORM NOSUBCLASS THRU EXIT-NOSUBCLASSif (SQLCODE NOT = 0 OR NORMSQ NOT = "00000" ) then MOVE 0 TO flagEND-IF if (NORMSQ = "00000" AND NORMSQ NOT = SQLSTATE)then DISPLAY "Valid implementation-defined SQLSTATE accepted." END-IF *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 NORMSQMOVE 3 TO norm1 *subclass begins in position 3 of char array NORMSQ *valid subclass begins with 5-9, I-Z, end of ALPNUM table PERFORM VARYING 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 GO TO EXIT-NOSUBCLASSEND-IF MOVE 4 TO norm1 *examining position 4 of char array NORMSQ *valid characters are 0-9, A-Z PERFORM VARYING 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 PERFORM VARYING 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 .
Messung V0.5 in Prozent C=80 H=94 G=87
¤ Dauer der Verarbeitung: 0.15 Sekunden
(vorverarbeitet am 2026-06-08)
¤ *© Formatika GbR, Deutschland
