Quellcode-Bibliothek© Kompilation durch diese Firma[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]Datei: dynsem.vdmsl Sprache: Cobol |
|
||||||
|
IDENTIFICATION DIVISION.
PROGRAM-ID. YTS753. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. xyz. OBJECT-COMPUTER. xyz. DATA DIVISION. WORKING-STORAGE SECTION. * EMBEDDED COBOL (file "YTS753.PCO") *Copyright 1996 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 * * YTS753.PCO * WRITTEN BY: Susan Watters * TRANSLATED AUTOMATICALLY FROM EMBEDDED C BY CHRIS SCHANZLE * * This routine tests DROP DOMAIN RESTRICT * * * REFERENCES * 11.27 <drop domain statement> * 11.21 <domain definition> * 21.2.5 DOMAINS view * F#25 Domain definition * F#3 Basic Schema Manipulation * * DATE LAST ALTERED 02.01.96 CTS5 Hand-over Test * * QA Status: Full FC * * Revised by DWF 1996-03-01 * Removed EXEC SQL from inside printfs * Cleanup * Fixed SDL transactions * Fixed printout * Added rollback after authid **************************************************************** 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). 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 END-EXEC MOVE SQLCODE TO SQL-COD EXEC SQL ROLLBACK WORK END-EXEC 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, Embedded COBOL, yts753.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 TEST7503 ******************* MOVE 1 TO flag DISPLAY " TEST7503 " DISPLAY " DROP DOMAIN RESTRICT" DISPLAY "References:" DISPLAY " 11.27 DISPLAY " 11.21 DISPLAY " 21.2.5 DOMAINS view" DISPLAY " F#25 Domain definition" DISPLAY " F#3 Basic Schema Manipulation" DISPLAY " - - - - - - - - - - - - - - - - - - -" *Create domain *Initialise error reporting variables COMPUTE SQLCODE = -1 MOVE "xxxxx" TO SQLSTATE DISPLAY "CREATE DOMAIN intdomain AS INTEGER;" EXEC SQL CREATE DOMAIN intdomain AS INTEGER END-EXEC MOVE SQLCODE TO SQL-COD *function CHCKOK checks for correct return of SQLSTATE PERFORM CHCKOK DISPLAY " " DISPLAY "COMMIT WORK;" EXEC SQL COMMIT WORK END-EXEC MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " *create table with column based on the domain COMPUTE SQLCODE = -1 MOVE "xxxxx" TO SQLSTATE DISPLAY "CREATE TABLE int_in_use" DISPLAY "( numerical intdomain," DISPLAY " literary char(10));" EXEC SQL CREATE TABLE int_in_use ( numerical intdomain, literary char(10)) END-EXEC MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " DISPLAY "COMMIT WORK;" EXEC SQL COMMIT WORK END-EXEC MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " *drop the domain *this should not succeed as the domain is in use MOVE 10000 TO SQLCODE MOVE "xxxxx" TO SQLSTATE DISPLAY "DROP DOMAIN intdomain RESTRICT" EXEC SQL DROP DOMAIN intdomain RESTRICT END-EXEC MOVE SQLCODE TO SQL-COD *That should generate a syntax error or access rule *violation which is SQLSTATE 42000 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 "COMMIT WORK;" EXEC SQL COMMIT WORK END-EXEC MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " *drop the table which references the domain COMPUTE SQLCODE = -1 MOVE "xxxxx" TO SQLSTATE DISPLAY "DROP TABLE int_in_use CASCADE;" EXEC SQL DROP TABLE int_in_use CASCADE END-EXEC MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " DISPLAY "COMMIT WORK;" EXEC SQL COMMIT WORK END-EXEC MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " *drop the domain *this should work as the domain is no longer in use COMPUTE SQLCODE = -1 MOVE "xxxxx" TO SQLSTATE DISPLAY "DROP DOMAIN intdomain RESTRICT " EXEC SQL DROP DOMAIN intdomain RESTRICT END-EXEC MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " DISPLAY "COMMIT WORK;" EXEC SQL COMMIT WORK END-EXEC MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " *try to recreate table *this should fail as the domain no longer exists DISPLAY "CREATE TABLE int_in_use" DISPLAY "( numerical intdomain," DISPLAY " literary char(10));" EXEC SQL CREATE TABLE int_in_use ( numerical intdomain, literary char(10)) END-EXEC 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 "ROLLBACK WORK;" EXEC SQL ROLLBACK WORK END-EXEC MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " if ( flag = 1 ) then DISPLAY " yts753.pco *** pass *** " EXEC SQL INSERT INTO CTS1.TESTREPORT VALUES('7503','pass','PCO') END-EXEC MOVE SQLCODE TO SQL-COD else DISPLAY " yts753.pco *** fail *** " EXEC SQL INSERT INTO CTS1.TESTREPORT VALUES('7503','fail','PCO') END-EXEC MOVE SQLCODE TO SQL-COD COMPUTE errcnt = errcnt + 1 END-IF DISPLAY "========================================" EXEC SQL COMMIT WORK END-EXEC MOVE SQLCODE TO SQL-COD ******************** END TEST7503 ******************** **** 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. ¤ Dauer der Verarbeitung: 0.26 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 |
