| 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: cob008.mco Sprache: Cobol |
|
||||||
|
IDENTIFICATION DIVISION.
PROGRAM-ID. MPB010. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. xyz. OBJECT-COMPUTER. xyz. DATA DIVISION. WORKING-STORAGE SECTION. * 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 * **************************************************************** * EXEC SQL BEGIN DECLARE SECTION END-EXEC 01 SQLCODE PIC S9(9) COMP. 01 SQLSTATE PIC X(5). 01 uid PIC X(18). 01 uidx PIC X(18). 01 int1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE. 01 progno PIC S9(9) DISPLAY SIGN LEADING SEPARATE. * EXEC SQL END DECLARE SECTION END-EXEC 01 pauze PIC S9(9) DISPLAY SIGN LEADING SEPARATE. 01 pauze2 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 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. 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. * 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. P0. 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" STOP RUN 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 FROM DATE ACCEPT THE-TIME FROM TIME 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 " TEST0627 " DISPLAY " DISPLAY " This is program 'B'" DISPLAY "References:" DISPLAY " 11.36 DISPLAY " FIPS PUB 127-2 14.1 Transitional SQL feature - " 3" DISPLAY " - - - - - - - - - - - - - - - - - - -" COMPUTE SQLCODE = -1 MOVE "xxxxx" TO SQLSTATE 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 GO TO 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 GO TO P198 END-IF COMPUTE fails = fails + 1 if (fails > maxfls) then GO TO 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 GO TO P104 END-IF *date_time print ACCEPT TO-DAY FROM DATE ACCEPT THE-TIME FROM TIME DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIME if (int1 = 1) then GO TO P196 END-IF if (int1 = 3) then GO TO P190 END-IF if (int1 = 5) then GO TO P189 END-IF GO TO 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 " " DISPLAY "COMMIT WORK;" * EXEC SQL COMMIT WORK; CALL "SUB9" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD MOVE 3 TO waitin GO TO P195 *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 " " DISPLAY "COMMIT WORK;" * EXEC SQL COMMIT WORK; CALL "SUB14" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD MOVE 5 TO waitin GO TO P195 *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 "COMMIT WORK;" * EXEC SQL COMMIT WORK; CALL "SUB22" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD 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 DISPLAY "COMMIT WORK;" * EXEC SQL COMMIT WORK; CALL "SUB24" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD COMPUTE waitin = -1 . P195. if (debug1 NOT = 0) then DISPLAY "Debug trace: P195" END-IF 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-TIME DISPLAY "Incrementing token" . P193. if (debug1 NOT = 0) then DISPLAY "Debug trace: P193" END-IF * EXEC SQL UPDATE TOKENS SET TOKEN_NO = TOKEN_NO + 1 * WHERE PROG_NO = :progno; CALL "SUB25" USING SQLCODE SQLSTATE progno MOVE SQLCODE TO SQL-COD if (SQLCODE < 0) then *Waste time and try again DISPLAY "SQLCODE = ", SQL-COD " SQLSTATE = ", SQLSTATE COMPUTE fails = fails + 1 if (fails > maxfls) then GO TO P199 END-IF *TEd hook for fixing delays: 025 PERFORM SLEEEP THRU P133 * EXEC SQL ROLLBACK WORK; CALL "SUB26" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD GO TO P193 END-IF * EXEC SQL COMMIT WORK; CALL "SUB27" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD if (SQLCODE < 0) then *Waste time and try again DISPLAY "SQLCODE = ", SQL-COD " SQLSTATE = ", SQLSTATE COMPUTE fails = fails + 1 if (fails > maxfls) then GO TO P199 END-IF *TEd hook for fixing delays: 026 PERFORM SLEEEP THRU P133 * EXEC SQL ROLLBACK WORK; CALL "SUB28" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD GO TO P193 END-IF *date_time print ACCEPT TO-DAY FROM DATE ACCEPT THE-TIME FROM TIME DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIME GO TO P194 *after token == 5 . P197. if (debug1 NOT = 0) then DISPLAY "Debug trace: P197" END-IF if ( flag = 1 ) then DISPLAY " *** pass *** " * EXEC SQL INSERT INTO TESTREPORT * VALUES('0627','pass','MCO'); CALL "SUB29" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD else DISPLAY " mpb010.sco *** fail *** " * EXEC SQL INSERT INTO TESTREPORT * VALUES('0627','fail','MCO'); CALL "SUB30" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD COMPUTE errcnt = errcnt + 1 END-IF DISPLAY "===============================================" * EXEC SQL COMMIT WORK; CALL "SUB31" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD ******************** END TEST0627 ******************** ******************** BEGIN TEST0628 ******************* MOVE 1 TO flag DISPLAY " TEST0628 " DISPLAY " DISPLAY " This is program 'B'" DISPLAY "References:" DISPLAY " 11.37 DISPLAY " FIPS PUB 127-2 14.1 Transitional SQL feature - " 3" DISPLAY " - - - - - - - - - - - - - - - - - - -" COMPUTE SQLCODE = -1 MOVE "xxxxx" TO SQLSTATE *date_time print ACCEPT TO-DAY FROM DATE ACCEPT THE-TIME FROM TIME 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 GO TO 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 GO TO P198 END-IF COMPUTE fails = fails + 1 if (fails > maxfls) then GO TO 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 GO TO P161 END-IF *date_time print ACCEPT TO-DAY FROM DATE ACCEPT THE-TIME FROM TIME DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIME if (int1 = 1) then GO TO P162 END-IF if (int1 = 3) then GO TO P170 END-IF GO TO 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 " " DISPLAY "COMMIT WORK;" * EXEC SQL COMMIT WORK; CALL "SUB38" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD MOVE 3 TO waitin GO TO P164 *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 " " DISPLAY "COMMIT WORK;" * EXEC SQL COMMIT WORK; CALL "SUB43" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD COMPUTE waitin = -1 . P164. if (debug1 NOT = 0) then DISPLAY "Debug trace: P164" END-IF 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-TIME DISPLAY "Incrementing token" . P165. if (debug1 NOT = 0) then DISPLAY "Debug trace: P165" END-IF * EXEC SQL UPDATE TOKENS SET TOKEN_NO = TOKEN_NO + 1 * WHERE PROG_NO = :progno; CALL "SUB44" USING SQLCODE SQLSTATE progno MOVE SQLCODE TO SQL-COD if (SQLCODE < 0) then *Waste time and try again DISPLAY "SQLCODE = ", SQL-COD " SQLSTATE = ", SQLSTATE COMPUTE fails = fails + 1 if (fails > maxfls) then GO TO P199 END-IF *TEd hook for fixing delays: 028 PERFORM SLEEEP THRU P133 * EXEC SQL ROLLBACK WORK; CALL "SUB45" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD GO TO P165 END-IF * EXEC SQL COMMIT WORK; CALL "SUB46" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD if (SQLCODE < 0) then *Waste time and try again DISPLAY "SQLCODE = ", SQL-COD " SQLSTATE = ", SQLSTATE COMPUTE fails = fails + 1 if (fails > maxfls) then GO TO P199 END-IF *TEd hook for fixing delays: 029 PERFORM SLEEEP THRU P133 * EXEC SQL ROLLBACK WORK; CALL "SUB47" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD GO TO P165 END-IF *date_time print ACCEPT TO-DAY FROM DATE ACCEPT THE-TIME FROM TIME DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIME GO TO P160 *after token == 3 . P163. if (debug1 NOT = 0) then DISPLAY "Debug trace: P163" END-IF if ( flag = 1 ) then DISPLAY " *** pass *** " * EXEC SQL INSERT INTO TESTREPORT * VALUES('0628','pass','MCO'); CALL "SUB48" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD else DISPLAY " mpb010.sco *** fail *** " * EXEC SQL INSERT INTO TESTREPORT * VALUES('0628','fail','MCO'); CALL "SUB49" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD COMPUTE errcnt = errcnt + 1 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 DISPLAY " TEST0560 " DISPLAY " Table privileges vs. column privileges" DISPLAY " This is program 'B'" DISPLAY "References:" DISPLAY " 11.37 DISPLAY " F# 3 -- Basic schema manipulation" DISPLAY " - - - - - - - - - - - - - - - - - - -" COMPUTE SQLCODE = -1 MOVE "xxxxx" TO SQLSTATE *date_time print ACCEPT TO-DAY FROM DATE ACCEPT THE-TIME FROM TIME 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 GO TO P198 END-IF COMPUTE fails = fails + 1 if (fails > maxfls * maxfls) then GO TO 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 GO TO P151 END-IF 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-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 DISPLAY "COMMIT WORK;" * EXEC SQL COMMIT WORK; CALL "SUB58" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " 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-TIME DISPLAY "Incrementing token" . P155. if (debug1 NOT = 0) then DISPLAY "Debug trace: P155" END-IF * EXEC SQL UPDATE TOKENS SET TOKEN_NO = TOKEN_NO + 1 * WHERE PROG_NO = :progno; CALL "SUB59" USING SQLCODE SQLSTATE progno MOVE SQLCODE TO SQL-COD if (SQLCODE < 0) then *Waste time and try again DISPLAY "SQLCODE = ", SQL-COD " SQLSTATE = ", SQLSTATE COMPUTE fails = fails + 1 if (fails > maxfls) then GO TO P199 END-IF *TEd hook for fixing delays: 031 PERFORM SLEEEP THRU P133 * EXEC SQL ROLLBACK WORK; CALL "SUB60" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD GO TO P155 END-IF * EXEC SQL COMMIT WORK; CALL "SUB61" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD if (SQLCODE < 0) then *Waste time and try again DISPLAY "SQLCODE = ", SQL-COD " SQLSTATE = ", SQLSTATE COMPUTE fails = fails + 1 if (fails > maxfls) then GO TO P199 END-IF *TEd hook for fixing delays: 032 PERFORM SLEEEP THRU P133 * EXEC SQL ROLLBACK WORK; CALL "SUB62" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD GO TO P155 END-IF *after token == 1 if ( flag = 1 ) then DISPLAY " *** pass *** " * EXEC SQL INSERT INTO TESTREPORT * VALUES('0560','pass','MCO'); CALL "SUB63" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD else DISPLAY " mpb010.sco *** fail *** " * EXEC SQL INSERT INTO TESTREPORT * VALUES('0560','fail','MCO'); CALL "SUB64" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD COMPUTE errcnt = errcnt + 1 END-IF DISPLAY "===============================================" * EXEC SQL COMMIT WORK; CALL "SUB65" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD ******************** END TEST0560 ******************** STOP RUN. 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." STOP RUN. * **** 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 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-NOSUBCLASS END-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-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 GO TO P133 END-IF . ¤ Dauer der Verarbeitung: 0.57 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 |
