|
IDENTIFICATION DIVISION.
PROGRAM-ID. SDL035.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. xyz.
OBJECT-COMPUTER. xyz.
DATA DIVISION.
WORKING-STORAGE SECTION.
* Standard COBOL (file "SDL035.SCO") calling SQL
* procedures in file "SDL035.MCO".
* STANDARD COBOL (file "SDL035.SCO")
****************************************************************
*
* COMMENT SECTION
*
* DATE 1992/06/22 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.
*
* SDL035.SCO
* WRITTEN BY: DAVID W. FLATER
*
* THIS ROUTINE TESTS THE SCHEMA DEFINITION LANGUAGE FOR SQL.
*
* REFERENCES
* ANSI SQL-1992
* 11.36 <grant statement>
*
****************************************************************
* EXEC SQL BEGIN DECLARE SECTION END-EXEC
01 ct20 PIC X(20).
01 ct1 PIC X(1).
01 uid PIC X(18).
01 uidx PIC X(18).
01 tmpcnt PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
* EXEC SQL END DECLARE SECTION END-EXEC
01 SQLCODE PIC S9(9) COMP.
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 ii PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 flag 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 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, sdl035.
- "pco"
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 TEST0477 *******************
MOVE 1 TO flag
DISPLAY " TEST0477 "
DISPLAY " Priv.violation: GRANT only SELECT on view"
DISPLAY "Reference ANSI SQL-1992 11.36 "
DISPLAY " - - - - - - - - - - - - - - - - - - -"
MOVE "x" TO ct20
DISPLAY "SELECT CHARTEST INTO :ct20 FROM CUGINI.VAA;"
* EXEC SQL SELECT CHARTEST
* INTO :ct20 FROM CUGINI.VAA;
CALL "SUB2" USING SQLCODE ct20
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO ii
DISPLAY "SQLCODE should be 0; its value is ", SQL-COD
DISPLAY "ct20 should be 'Twenty Characters...'; its value
- " is ", ct20
if (ii NOT = 0 OR ct20 NOT = "Twenty Characters...") then
MOVE 0 TO flag
END-IF
DISPLAY "INSERT INTO CUGINI.VAA VALUES ('This should not
- " work');"
* EXEC SQL INSERT INTO CUGINI.VAA
* VALUES ('This should not work');
CALL "SUB3" USING SQLCODE
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO ii
DISPLAY "SQLCODE should be < 0; its value is ", ii
if (ii NOT < 0) then
MOVE 0 TO flag
END-IF
DISPLAY "SELECT COUNT(*) FROM CUGINI.VAA;"
COMPUTE tmpcnt = -1
* EXEC SQL SELECT COUNT(*) INTO :tmpcnt
* FROM CUGINI.VAA;
CALL "SUB4" USING SQLCODE tmpcnt
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO ii
DISPLAY "SQLCODE should be 0; its value is ", ii
DISPLAY "COUNT should be 1; its value is ", tmpcnt
if (ii NOT = 0 OR tmpcnt NOT = 1) then
MOVE 0 TO flag
END-IF
DISPLAY "UPDATE CUGINI.VAA"
DISPLAY " SET CHARTEST = 'This should not work';"
* EXEC SQL UPDATE CUGINI.VAA
* SET CHARTEST = 'This should not work';
CALL "SUB5" USING SQLCODE
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO ii
DISPLAY "SQLCODE should be < 0; its value is ", ii
if (ii NOT < 0) then
MOVE 0 TO flag
END-IF
DISPLAY "SELECT COUNT(*) FROM CUGINI.VAA WHERE"
DISPLAY "CHARTEST <> 'Twenty Characters...';"
COMPUTE tmpcnt = -1
* EXEC SQL SELECT COUNT(*) INTO :tmpcnt
* FROM CUGINI.VAA WHERE CHARTEST
* <> 'Twenty Characters...';
CALL "SUB6" USING SQLCODE tmpcnt
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO ii
DISPLAY "SQLCODE should be 0; its value is ", ii
DISPLAY "COUNT should be 0; its value is ", tmpcnt
if (ii NOT = 0 OR tmpcnt NOT = 0) then
MOVE 0 TO flag
END-IF
DISPLAY "DELETE FROM CUGINI.VAA;"
* EXEC SQL DELETE FROM CUGINI.VAA;
CALL "SUB7" USING SQLCODE
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO ii
DISPLAY "SQLCODE should be < 0; its value is ", ii
if (ii NOT < 0) then
MOVE 0 TO flag
END-IF
DISPLAY "SELECT COUNT(*) FROM CUGINI.VAA;"
COMPUTE tmpcnt = -1
* EXEC SQL SELECT COUNT(*) INTO :tmpcnt
* FROM CUGINI.VAA;
CALL "SUB8" USING SQLCODE tmpcnt
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO ii
DISPLAY "SQLCODE should be 0; its value is ", ii
DISPLAY "COUNT should be 1; its value is ", tmpcnt
if (ii NOT = 0 OR tmpcnt NOT = 1) then
MOVE 0 TO flag
END-IF
* EXEC SQL ROLLBACK WORK;
CALL "SUB9" USING SQLCODE
MOVE SQLCODE TO SQL-COD
if ( flag = 1 ) then
DISPLAY " *** pass *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0477','pass','MCO');
CALL "SUB10" USING SQLCODE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " sdl035.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0477','fail','MCO');
CALL "SUB11" USING SQLCODE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB12" USING SQLCODE
MOVE SQLCODE TO SQL-COD
******************** END TEST0477 ********************
******************** BEGIN TEST0478 *******************
MOVE 1 TO flag
DISPLAY " TEST0478 "
DISPLAY " Priv.violation: GRANT only INSERT on view"
DISPLAY "Reference ANSI SQL-1992 11.36 "
DISPLAY " - - - - - - - - - - - - - - - - - - -"
DISPLAY "INSERT INTO CUGINI.VBB VALUES ('A');"
* EXEC SQL INSERT INTO CUGINI.VBB
* VALUES ('A');
CALL "SUB13" USING SQLCODE
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO ii
DISPLAY "SQLCODE should be = 0; its value is ", ii
if (ii NOT = 0) then
MOVE 0 TO flag
END-IF
MOVE "x" TO ct1
DISPLAY "SELECT CHARTEST INTO :ct1 FROM CUGINI.VBB;"
* EXEC SQL SELECT CHARTEST INTO :ct1 FROM CUGINI.VBB;
CALL "SUB14" USING SQLCODE ct1
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO ii
DISPLAY "SQLCODE should be < 0; its value is ", ii
DISPLAY "ct1 should NOT be A; its value is ", ct1
if (ii NOT < 0 OR ct1 = "A") then
MOVE 0 TO flag
END-IF
DISPLAY "UPDATE CUGINI.VBB SET CHARTEST = 'B';"
* EXEC SQL UPDATE CUGINI.VBB
* SET CHARTEST = 'B';
CALL "SUB15" USING SQLCODE
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO ii
DISPLAY "SQLCODE should be < 0; its value is ", ii
if (ii NOT < 0) then
MOVE 0 TO flag
END-IF
DISPLAY "DELETE FROM CUGINI.VBB;"
* EXEC SQL DELETE FROM CUGINI.VBB;
CALL "SUB16" USING SQLCODE
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO ii
DISPLAY "SQLCODE should be < 0; its value is ", ii
if (ii NOT < 0) then
MOVE 0 TO flag
END-IF
* EXEC SQL ROLLBACK WORK;
CALL "SUB17" USING SQLCODE
MOVE SQLCODE TO SQL-COD
if ( flag = 1 ) then
DISPLAY " *** pass *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0478','pass','MCO');
CALL "SUB18" USING SQLCODE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " sdl035.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0478','fail','MCO');
CALL "SUB19" USING SQLCODE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB20" USING SQLCODE
MOVE SQLCODE TO SQL-COD
******************** END TEST0478 ********************
******************** BEGIN TEST0479 *******************
MOVE 1 TO flag
DISPLAY " TEST0479 "
DISPLAY " Priv.violation: GRANT only UPDATE on view"
DISPLAY "Reference ANSI SQL-1992 11.36 "
DISPLAY " - - - - - - - - - - - - - - - - - - -"
DISPLAY "UPDATE CUGINI.VCC"
DISPLAY " SET CHARTEST = 'This --should-- work';"
* EXEC SQL UPDATE CUGINI.VCC
* SET CHARTEST = 'This --should-- work';
CALL "SUB21" USING SQLCODE
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO ii
DISPLAY "SQLCODE should be = 0; its value is ", ii
if (ii NOT = 0) then
MOVE 0 TO flag
END-IF
DISPLAY "SELECT CHARTEST INTO :ct20 FROM CUGINI.VCC;"
MOVE "x" TO ct20
* EXEC SQL SELECT CHARTEST
* INTO :ct20 FROM CUGINI.VCC;
CALL "SUB22" USING SQLCODE ct20
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO ii
DISPLAY "SQLCODE should be < 0; its value is ", ii
DISPLAY
"ct20 should NOT be 'This --should-- work';its value is ",
ct20
if (ii NOT < 0 OR ct20 = "This --should-- work") then
MOVE 0 TO flag
END-IF
DISPLAY "INSERT INTO CUGINI.VCC VALUES ('This should not
- " work');"
* EXEC SQL INSERT INTO CUGINI.VCC
* VALUES ('This should not work');
CALL "SUB23" USING SQLCODE
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO ii
DISPLAY "SQLCODE should be < 0; its value is ", ii
if (ii NOT < 0) then
MOVE 0 TO flag
END-IF
DISPLAY "DELETE FROM CUGINI.VCC;"
* EXEC SQL DELETE FROM CUGINI.VCC;
CALL "SUB24" USING SQLCODE
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO ii
DISPLAY "SQLCODE should be < 0; its value is ", ii
if (ii NOT < 0) then
MOVE 0 TO flag
END-IF
* EXEC SQL ROLLBACK WORK;
CALL "SUB25" USING SQLCODE
MOVE SQLCODE TO SQL-COD
if ( flag = 1 ) then
DISPLAY " *** pass *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0479','pass','MCO');
CALL "SUB26" USING SQLCODE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " sdl035.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0479','fail','MCO');
CALL "SUB27" USING SQLCODE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB28" USING SQLCODE
MOVE SQLCODE TO SQL-COD
******************** END TEST0479 ********************
******************** BEGIN TEST0480 *******************
MOVE 1 TO flag
DISPLAY " TEST0480 "
DISPLAY " Priv.violation: GRANT only DELETE on view"
DISPLAY "Reference ANSI SQL-1992 11.36 "
DISPLAY " - - - - - - - - - - - - - - - - - - -"
DISPLAY "DELETE FROM CUGINI.VDD;"
* EXEC SQL DELETE FROM CUGINI.VDD;
CALL "SUB29" USING SQLCODE
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO ii
DISPLAY "SQLCODE should be = 0; its value is ", ii
if (ii NOT = 0) then
MOVE 0 TO flag
END-IF
DISPLAY "INSERT INTO CUGINI.VDD VALUES ('A');"
* EXEC SQL INSERT INTO CUGINI.VDD
* VALUES ('A');
CALL "SUB30" USING SQLCODE
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO ii
DISPLAY "SQLCODE should be < 0; its value is ", ii
if (ii NOT < 0) then
MOVE 0 TO flag
END-IF
DISPLAY "SELECT CHARTEST INTO :ct1 FROM CUGINI.VDD;"
MOVE "x" TO ct1
* EXEC SQL SELECT CHARTEST INTO :ct1 FROM CUGINI.VDD;
CALL "SUB31" USING SQLCODE ct1
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO ii
DISPLAY "SQLCODE should be < 0; its value is ", ii
DISPLAY "ct1 should NOT be 'a' or 'A'; its value is ", ct1
if (ii NOT < 0 OR ct1 = "a") then
MOVE 0 TO flag
END-IF
if (ct1 = "A") then
MOVE 0 TO flag
END-IF
DISPLAY "UPDATE CUGINI.VDD SET CHARTEST = 'B';"
* EXEC SQL UPDATE CUGINI.VDD
* SET CHARTEST = 'B';
CALL "SUB32" USING SQLCODE
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO ii
DISPLAY "SQLCODE should be < 0; its value is ", ii
if (ii NOT < 0) then
MOVE 0 TO flag
END-IF
* EXEC SQL ROLLBACK WORK;
CALL "SUB33" USING SQLCODE
MOVE SQLCODE TO SQL-COD
if ( flag = 1 ) then
DISPLAY " *** pass *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0480','pass','MCO');
CALL "SUB34" USING SQLCODE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " sdl035.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0480','fail','MCO');
CALL "SUB35" USING SQLCODE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB36" USING SQLCODE
MOVE SQLCODE TO SQL-COD
******************** END TEST0480 ********************
**** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0
STOP RUN.
* **** Procedures for PERFORM statements
¤ Dauer der Verarbeitung: 0.62 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.
|
