| credits |
|
Quellcode-Bibliothek
© Kompilation durch diese Firma
[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]
Datei: xts767.cob Sprache: Cobol
|
IDENTIFICATION DIVISION.
PROGRAM-ID. XTS767. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. xyz. OBJECT-COMPUTER. xyz. DATA DIVISION. WORKING-STORAGE SECTION. * Standard COBOL (file "XTS767.SCO") calling SQL * procedures in file "XTS767.MCO". *Copyright 1995 National Computing Centre Limited *and Computer Logic R&D S.A *on behalf of the CTS5 SQL2 Project. *All rights reserved. *The CTS5 SQL2 Project is sponsored by the European Community. * *The National Computing Centre Limited and Computer Logic R&D *have given permission to NIST to distribute this program *over the World Wide Web in order to promote SQL standards. *DISCLAIMER: *This program was reviewed by employees of NIST for *conformance to the SQL standards. *NIST assumes no responsibility for any party's use of *this program. **************************************************************** * * COMMENT SECTION * * SQL VALIDATION TEST SUITE V6.0 * * XTS767.SCO * WRITTEN BY: Nickos Backalidis * TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE * * Drop character, outstanding granted privileges * * REFERENCES * 11.29 -- <Drop character set statement> * TC#1 -- 11.29 * 11.29 GR.1 * 11.29 SR.3 * 11.37 -- <revoke statement> * F#2 -- Basic Information Schema * F#3 -- Basic Schema Manipulation * F#32 -- User authorization * F#45 -- Character set definition. * * DATE LAST ALTERED 18/12/95 CTS5 Hand-over Test * * Cleanups and fixes by V. Kogakis 18/12/95 * Print timestamp * Include Files * Define NOSUBCLASS/CHCKOK at test beginning * * QA STATUS : QA CHECK * * Revised by DWF 1996-02-26 * Fixed schema references * Removed field widths from printfs * Fixed SDL transactions * Feedback on imp-defined SQLSTATEs * Removed SQL syntax errors, cleaned up syntax **************************************************************** * 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 coun PIC S9(9) DISPLAY SIGN LEADING SEPARATE. * EXEC SQL END DECLARE SECTION END-EXEC 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. *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 "CTS1 " TO uid CALL "AUTHID" USING uid MOVE "not logged in, not" TO uidx * EXEC SQL SELECT USER INTO :uidx FROM CTS1.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, xts767.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 ******************** BEGIN TEST7067 ******************* MOVE 1 TO flag DISPLAY " TEST7067" DISPLAY " DROP character set, outstanding granted - " privileges" DISPLAY " References:" DISPLAY " 11.29 -- DISPLAY " 11.29 GR.1" DISPLAY " 11.29 SR.3 " DISPLAY " 11.37 -- DISPLAY " F#2 -- Basic Information Schema" DISPLAY " F#3 -- Basic schema manipulation" DISPLAY " F#32 -- User authorization " DISPLAY " F#45 -- Character set definition " DISPLAY " - - - - - - - - - - - - - - - - - - -" DISPLAY "This test attempts to change session - " authorizations. Because" DISPLAY "authorizations are implementation-defined, this - " test may need" DISPLAY "modification. The following actions may help to - " pass the test:" DISPLAY " -- Change the initial authid to an authid with - " DBA privileges" DISPLAY " -- Insert code to work around - " implementation-defined" DISPLAY " authentication mechanisms (e.g. to reconnect - " with a" DISPLAY " different authid)." DISPLAY "It might not be possible to change the session - " authorization," DISPLAY "as explained in 16.4 GR.4. In this case, the - " restrictions that" DISPLAY "render it impossible should be documented and the - " test assumed" DISPLAY "to be passed." *Initialise error reporting variables COMPUTE SQLCODE = -1 MOVE "xxxxx" TO SQLSTATE *create a character set under the current schema DISPLAY "CREATE CHARACTER SET TESTSET GET SQL_TEXT;" * EXEC SQL CREATE CHARACTER SET TESTSET GET SQL_TEXT; CALL "SUB3" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " DISPLAY "COMMIT WORK;" * EXEC SQL COMMIT WORK; CALL "SUB4" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " *grant privileges for TESTSET on user CTS3 DISPLAY "GRANT USAGE ON CHARACTER SET TESTSET TO CTS3;" * EXEC SQL GRANT USAGE ON CHARACTER SET TESTSET TO CTS3 * ; CALL "SUB5" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " DISPLAY "COMMIT WORK;" * EXEC SQL COMMIT WORK; CALL "SUB6" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " *now change to user CTS3 and create a table based on *character set TESTSET DISPLAY "SET SESSION AUTHORIZATION 'CTS3';" * EXEC SQL SET SESSION AUTHORIZATION 'CTS3'; CALL "SUB7" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " DISPLAY "CREATE TABLE TEMP767 " DISPLAY " ( COLCH1 CHAR(10) CHARACTER SET CTS1.TESTSET," DISPLAY " COLCH2 CHAR(5) CHARACTER SET CTS1.TESTSET);" * EXEC SQL CREATE TABLE TEMP767 * ( COLCH1 CHAR(10) CHARACTER SET CTS1.TESTSET, * COLCH2 CHAR(5) CHARACTER SET CTS1.TESTSET); CALL "SUB8" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " DISPLAY "COMMIT WORK;" * EXEC SQL COMMIT WORK; CALL "SUB9" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " *now change back to CTS1 DISPLAY "SET SESSION AUTHORIZATION 'CTS1';" * EXEC SQL SET SESSION AUTHORIZATION 'CTS1'; CALL "SUB10" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " *now attempt to drop the character set DISPLAY "DROP CHARACTER SET TESTSET;" * EXEC SQL DROP CHARACTER SET TESTSET; CALL "SUB11" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD if (SQLCODE NOT < 0) then MOVE 0 TO flag END-IF DISPLAY "SQLSTATE should be 42000; its value is ", SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (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 "SUB12" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " *now change to user CTS3 and and destroy table TEMP767 DISPLAY "SET SESSION AUTHORIZATION 'CTS3';" * EXEC SQL SET SESSION AUTHORIZATION 'CTS3'; CALL "SUB13" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " DISPLAY "DROP TABLE TEMP767 CASCADE;" * EXEC SQL DROP TABLE TEMP767 CASCADE; CALL "SUB14" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " DISPLAY "COMMIT WORK;" * EXEC SQL COMMIT WORK; CALL "SUB15" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " *now change to CTS1 and drop TESTSET. This should now *work with no side effects and normal behaviour DISPLAY "SET SESSION AUTHORIZATION 'CTS1';" * EXEC SQL SET SESSION AUTHORIZATION 'CTS1'; CALL "SUB16" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " *now drop the character set DISPLAY "DROP CHARACTER SET TESTSET;" * EXEC SQL DROP CHARACTER SET TESTSET; CALL "SUB17" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " DISPLAY "COMMIT WORK;" * EXEC SQL COMMIT WORK; CALL "SUB18" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " *now access the CHARACTER_SETS view and check that *there exist no rows where the char set TESTSET is *identified MOVE 4 TO coun DISPLAY "SELECT COUNT(*) INTO :coun " DISPLAY "FROM INFORMATION_SCHEMA.CHARACTER_SETS " DISPLAY "WHERE CHARACTER_SET_SCHEMA = 'CTS1' " DISPLAY "AND CHARACTER_SET_NAME = 'TESTSET';" * EXEC SQL SELECT COUNT(*) INTO :coun * FROM INFORMATION_SCHEMA.CHARACTER_SETS * WHERE CHARACTER_SET_SCHEMA = 'CTS1' * AND CHARACTER_SET_NAME = 'TESTSET'; CALL "SUB19" USING SQLCODE SQLSTATE coun MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY "coun should be 0; its value is ", coun if (coun NOT = 0) then MOVE 0 TO flag END-IF DISPLAY " " *initialise host variables to values <> 0 since zeros *are expected to be returned by all COUNTs MOVE 9 TO coun *now access the USAGE_PRIVILEGES view DISPLAY "SELECT COUNT(*) INTO :coun" DISPLAY " FROM INFORMATION_SCHEMA.USAGE_PRIVILEGES" DISPLAY " WHERE OBJECT_SCHEMA = 'CTS1'" DISPLAY " AND OBJECT_TYPE = 'CHARACTER SET'" DISPLAY " AND OBJECT_NAME = 'TESTSET';" * EXEC SQL SELECT COUNT(*) INTO :coun * FROM INFORMATION_SCHEMA.USAGE_PRIVILEGES * WHERE OBJECT_SCHEMA = 'CTS1' * AND OBJECT_TYPE = 'CHARACTER SET' * AND OBJECT_NAME = 'TESTSET'; CALL "SUB20" USING SQLCODE SQLSTATE coun MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY "coun should be 0; its value is ", coun if (coun NOT = 0) then MOVE 0 TO flag END-IF DISPLAY " " DISPLAY "ROLLBACK WORK;" * EXEC SQL ROLLBACK WORK; CALL "SUB21" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " *now record results if ( flag = 1 ) then DISPLAY " xts767.mco *** pass *** " * EXEC SQL INSERT INTO CTS1.TESTREPORT * VALUES('7067','pass','MCO'); CALL "SUB22" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD else DISPLAY " xts767.mco *** fail *** " * EXEC SQL INSERT INTO CTS1.TESTREPORT * VALUES('7067','fail','MCO'); CALL "SUB23" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD COMPUTE errcnt = errcnt + 1 END-IF DISPLAY "========================================" * EXEC SQL COMMIT WORK; CALL "SUB24" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD ******************** END TEST7067 ******************** **** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0 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. [ zur Elbe Produktseite wechseln0.28Quellennavigators Analyse erneut starten ] |