|
|
|
|
Quellcode-Bibliothek
© Kompilation durch diese Firma
[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]
Datei:
sdl029.cob
Sprache: Unknown
IDENTIFICATION DIVISION.
PROGRAM-ID. SDL029.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. xyz.
OBJECT-COMPUTER. xyz.
DATA DIVISION.
WORKING-STORAGE SECTION.
* Standard COBOL (file "SDL029.SCO") calling SQL
* procedures in file "SDL029.MCO".
* STANDARD COBOL (file "SDL029.SCO")
****************************************************************
*
* COMMENT SECTION
*
* DATE 1992/06/05 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.
*
* SDL029.SCO
* WRITTEN BY: DAVID W. FLATER
*
* THIS ROUTINE TESTS THE SCHEMA DEFINITION LANGUAGE FOR SQL.
*
* REFERENCES
* ANSI SQL-1989, 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, sdl029.
- "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 TEST0458 *******************
MOVE 1 TO flag
DISPLAY " TEST0458 "
DISPLAY " Priv.violation: GRANT only SELECT to indiv."
DISPLAY "Reference ANSI SQL-1992 11.36 "
DISPLAY " - - - - - - - - - - - - - - - - - - -"
MOVE "x" TO ct20
DISPLAY "SELECT CHARTEST INTO :ct20 FROM CUGINI.AA;"
* EXEC SQL SELECT CHARTEST
* INTO :ct20 FROM CUGINI.AA;
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.AA VALUES ('This should not
- " work');"
* EXEC SQL INSERT INTO CUGINI.AA
* 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.AA;"
COMPUTE tmpcnt = -1
* EXEC SQL SELECT COUNT(*) INTO :tmpcnt
* FROM CUGINI.AA;
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.AA"
DISPLAY " SET CHARTEST = 'This should not work';"
* EXEC SQL UPDATE CUGINI.AA
* 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.AA WHERE"
DISPLAY "CHARTEST <> 'Twenty Characters...';"
COMPUTE tmpcnt = -1
* EXEC SQL SELECT COUNT(*) INTO :tmpcnt
* FROM CUGINI.AA 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.AA;"
* EXEC SQL DELETE FROM CUGINI.AA;
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.AA;"
COMPUTE tmpcnt = -1
* EXEC SQL SELECT COUNT(*) INTO :tmpcnt
* FROM CUGINI.AA;
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('0458','pass','MCO');
CALL "SUB10" USING SQLCODE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " sdl029.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0458','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 TEST0458 ********************
******************** BEGIN TEST0459 *******************
MOVE 1 TO flag
DISPLAY " TEST0459 "
DISPLAY " Priv.violation: GRANT only INSERT to indiv."
DISPLAY " Reference X3.135-89 section 6.10
- " "
DISPLAY " - - - - - - - - - - - - - - - - - - -"
DISPLAY "INSERT INTO CUGINI.BB VALUES ('A');"
* EXEC SQL INSERT INTO CUGINI.BB
* 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.BB;"
* EXEC SQL SELECT CHARTEST INTO :ct1 FROM CUGINI.BB;
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.BB SET CHARTEST = 'B';"
* EXEC SQL UPDATE CUGINI.BB
* 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.BB;"
* EXEC SQL DELETE FROM CUGINI.BB;
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('0459','pass','MCO');
CALL "SUB18" USING SQLCODE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " sdl029.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0459','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 TEST0459 ********************
******************** BEGIN TEST0460 *******************
MOVE 1 TO flag
DISPLAY " TEST0460 "
DISPLAY " Priv.violation: GRANT only UPDATE to indiv."
DISPLAY " Reference X3.135-89 section 6.10
- " "
DISPLAY " - - - - - - - - - - - - - - - - - - -"
DISPLAY "UPDATE CUGINI.CC"
DISPLAY " SET CHARTEST = 'This --should-- work';"
* EXEC SQL UPDATE CUGINI.CC
* 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.CC;"
MOVE "x" TO ct20
* EXEC SQL SELECT CHARTEST
* INTO :ct20 FROM CUGINI.CC;
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.CC VALUES ('This should not
- " work');"
* EXEC SQL INSERT INTO CUGINI.CC
* 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.CC;"
* EXEC SQL DELETE FROM CUGINI.CC;
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('0460','pass','MCO');
CALL "SUB26" USING SQLCODE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " sdl029.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0460','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 TEST0460 ********************
******************** BEGIN TEST0461 *******************
MOVE 1 TO flag
DISPLAY " TEST0461 "
DISPLAY " Priv.violation: GRANT only DELETE to indiv."
DISPLAY " Reference X3.135-89 section 6.10
- " "
DISPLAY " - - - - - - - - - - - - - - - - - - -"
DISPLAY "DELETE FROM CUGINI.DD;"
* EXEC SQL DELETE FROM CUGINI.DD;
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.DD VALUES ('A');"
* EXEC SQL INSERT INTO CUGINI.DD
* 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.DD;"
MOVE "x" TO ct1
* EXEC SQL SELECT CHARTEST INTO :ct1 FROM CUGINI.DD;
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.DD SET CHARTEST = 'B';"
* EXEC SQL UPDATE CUGINI.DD
* 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('0461','pass','MCO');
CALL "SUB34" USING SQLCODE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " sdl029.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0461','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 TEST0461 ********************
**** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0
STOP RUN.
* **** Procedures for PERFORM statements
[ Dauer der Verarbeitung: 0.6 Sekunden
(vorverarbeitet)
]
|
|
|
|
|
|
