| 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: xts754.cob Sprache: Unknown
|
IDENTIFICATION DIVISION.
PROGRAM-ID. XTS754. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. xyz. OBJECT-COMPUTER. xyz. DATA DIVISION. WORKING-STORAGE SECTION. * Standard COBOL (file "XTS754.SCO") calling SQL * procedures in file "XTS754.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 * * XTS754.SCO * WRITTEN BY: Nickos Backalidis * TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE * * ALTER TABLE ADD COLUMN WITH domain and constraint * * REFERENCES * 11.10 -- <Alter table statement> * 11.10 AR.1 * 11.11 -- <Add column definition> * 11.1 GR.1 * 11.4 -- <column definition> * F#2 -- Basic Information Schema * F#25 -- Domain definition * F#38 -- Schema manipulation * * DATE LAST ALTERED 18/12/95 CTS5 Hand-over Test * * Cleanups and fixes by V. Kogakis 15/12/95 * Print timestamp * Include Files * Define NOSUBCLASS/CHCKOK at test beginning * * QA STATUS : QA CHECK * * Revised by DWF 1996-02-20 * Fixed SDL transactions * Removed field widths in printfs * Added a subtest **************************************************************** * 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, xts754.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 TEST7054 ******************* MOVE 1 TO flag DISPLAY " TEST7054" DISPLAY " ALTER TABLE ADD COLUMN WITH domain and - " constraint " DISPLAY " References " DISPLAY " 11.10 -- DISPLAY " 11.10 AR.1 " DISPLAY " 11.11 -- DISPLAY " 11.11 GR.1 " DISPLAY " 11.4 -- DISPLAY " F#2 -- Basic Information Schema " DISPLAY " F#25 -- Domain definition" DISPLAY " F#38 -- Schema manipulation " DISPLAY " - - - - - - - - - - - - - - - - - - -" *initialise error reporting variables COMPUTE SQLCODE = -1 MOVE "xxxxx" TO SQLSTATE *create a table domain under the current schema *with a domain and check constraint specified DISPLAY "CREATE DOMAIN DOM6138 AS INTEGER" DISPLAY "CHECK (VALUE > 1000)" DISPLAY "CHECK (VALUE < 2000);" * EXEC SQL CREATE DOMAIN DOM6138 AS INTEGER * CHECK (VALUE > 1000) * CHECK (VALUE < 2000); 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 " " *create table TAB754 DISPLAY "CREATE TABLE TAB754" DISPLAY "(C1 NUMERIC(5)," DISPLAY " C2 DECIMAL(4));" * EXEC SQL CREATE TABLE TAB754 * (C1 NUMERIC(5), * C2 DECIMAL(4)); 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 alter the table and add a column based on DOM6138 DISPLAY "ALTER TABLE TAB754 ADD COLUMN COLDOM DOM6138" DISPLAY "CONSTRAINT c3dom_check CHECK (COLDOM <= 1998);" * EXEC SQL ALTER TABLE CTS1.TAB754 ADD COLUMN COLDOM DOM6138 * CONSTRAINT c3dom_check CHECK (COLDOM <= 1998); CALL "SUB7" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " DISPLAY "COMMIT WORK;" * EXEC SQL COMMIT WORK; CALL "SUB8" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " *access the COLUMN_DOMAIN_USAGE view and check that *the column COLDOM is present MOVE 0 TO coun DISPLAY "SELECT COUNT(*) INTO :coun" DISPLAY "FROM INFORMATION_SCHEMA.COLUMN_DOMAIN_USAGE " DISPLAY "WHERE DOMAIN_SCHEMA = 'CTS1' AND DOMAIN_NAME = - " 'DOM6138'" DISPLAY "AND TABLE_SCHEMA = 'CTS1' AND TABLE_NAME = - " 'TAB754'" DISPLAY "AND COLUMN_NAME = 'COLDOM';" * EXEC SQL SELECT COUNT(*) INTO :coun * FROM INFORMATION_SCHEMA.COLUMN_DOMAIN_USAGE * WHERE DOMAIN_SCHEMA = 'CTS1' AND DOMAIN_NAME = 'DOM6138' * AND TABLE_SCHEMA = 'CTS1' AND TABLE_NAME = 'TAB754' * AND COLUMN_NAME = 'COLDOM'; CALL "SUB9" USING SQLCODE SQLSTATE coun MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY "coun should be 1; its value is ", coun if (coun NOT = 1) then MOVE 0 TO flag END-IF DISPLAY " " *insert one valid row in CTS1.TAB754 DISPLAY "INSERT INTO TAB754 VALUES(1000,766,1990);" * EXEC SQL INSERT INTO TAB754 VALUES(1000,766,1990); CALL "SUB10" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " *now add a row which violates the check constraint *with value 1999 but not the domain constraint *and should fail DISPLAY "INSERT INTO TAB754 VALUES(1001,767,1999);" * EXEC SQL INSERT INTO TAB754 VALUES(1001,767,1999); CALL "SUB11" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD *That should generate an integrity constraint violation *which is SQLSTATE 23000 DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD DISPLAY "SQLSTATE should be 23000; its value is ", SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (SQLCODE NOT < 0) then MOVE 0 TO flag END-IF if (NORMSQ NOT = "23000") then MOVE 0 TO flag END-IF if (NORMSQ = "23000" AND NORMSQ NOT = SQLSTATE) then DISPLAY "Valid implementation-defined SQLSTATE accepted." END-IF DISPLAY " " *(DWF) Test the domain constraint too. DISPLAY "INSERT INTO TAB754 VALUES(1001,767,0);" * EXEC SQL INSERT INTO TAB754 VALUES(1001,767,0); CALL "SUB12" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD *That should generate an integrity constraint violation *which is SQLSTATE 23000 DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD DISPLAY "SQLSTATE should be 23000; its value is ", SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (SQLCODE NOT < 0) then MOVE 0 TO flag END-IF if (NORMSQ NOT = "23000") then MOVE 0 TO flag END-IF if (NORMSQ = "23000" AND NORMSQ NOT = SQLSTATE) then DISPLAY "Valid implementation-defined SQLSTATE accepted." END-IF DISPLAY " " DISPLAY "ROLLBACK WORK;" * EXEC SQL ROLLBACK WORK; CALL "SUB13" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " *now restore database in its original state DISPLAY "DROP TABLE TAB754 CASCADE;" * EXEC SQL DROP TABLE TAB754 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 " " DISPLAY "DROP DOMAIN DOM6138 CASCADE;" * EXEC SQL DROP DOMAIN DOM6138 CASCADE; CALL "SUB16" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " DISPLAY "COMMIT WORK;" * EXEC SQL COMMIT WORK; CALL "SUB17" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " *record results if ( flag = 1 ) then DISPLAY " xts754.mco *** pass *** " * EXEC SQL INSERT INTO CTS1.TESTREPORT * VALUES('7054','pass','MCO'); CALL "SUB18" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD else DISPLAY " xts754.mco *** fail *** " * EXEC SQL INSERT INTO CTS1.TESTREPORT * VALUES('7054','fail','MCO'); CALL "SUB19" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD COMPUTE errcnt = errcnt + 1 END-IF DISPLAY "========================================" * EXEC SQL COMMIT WORK; CALL "SUB20" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD ******************** END TEST7054 ******************** **** 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.6 Sekunden (vorverarbeitet) ] |