|
IDENTIFICATION DIVISION.
PROGRAM-ID. YTS770.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. xyz.
OBJECT-COMPUTER. xyz.
DATA DIVISION.
WORKING-STORAGE SECTION.
* EMBEDDED COBOL (file "YTS770.PCO")
*Copyright 1996 National Computing Centre Ltd,
*and Computer Logic R&D S.A
*on behalf of 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
*
* YTS770.PCO
* WRITTEN BY: Susan Watters
* TRANSLATED AUTOMATICALLY FROM EMBEDDED C BY CHRIS SCHANZLE
*
* This routine tests Access to DOMAIN_CONSTRAINTS
*
*
* REFERENCES
* 21.2.6 DOMAIN_CONSTRAINTS view
* 11.21 <domain definition>
* F#35 Intermediate information schema
* F#17 Multiple schemas per user
* F#25 Domain definition
*
* DATE LAST ALTERED 02.01.96 CTS5 Hand-over Test
* Initial review comments from DWF addressed 27/10/95
*
* QA Status: Full FC
*
* Revised by DWF 1996-03-12
* Added rollback after authid
* Cleanup
* Fixed bad printf format
* Fixed pass criteria
****************************************************************
EXEC SQL BEGIN DECLARE SECTION END-EXEC
01 SQLCODE PIC S9(9) COMP.
01 SQLSTATE PIC X(5).
01 co PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 DOMN PIC X(128).
01 DOMS PIC X(128).
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 i PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 flag PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 flag2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 flag3 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, yts770.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 TEST7552 *******************
MOVE 1 TO flag
MOVE 1 TO flag2
MOVE 1 TO flag3
DISPLAY " TEST7552 "
DISPLAY " Access to DOMAIN_CONSTRAINTS view"
DISPLAY "References:"
DISPLAY " 21.2.6 DOMAIN_CONSTRAINTS view "
DISPLAY " 11.21 "
DISPLAY " F#35 Intermediate information schema"
DISPLAY " F#17 Multiple schemas per user"
DISPLAY " F#25 Domain definition"
DISPLAY " - - - - - - - - - - - - - - - - - - -"
COMPUTE SQLCODE = -1
MOVE "xxxxx" TO SQLSTATE
*prepare database for the test
DISPLAY "DROP DOMAIN cts1b.esal CASCADE;"
* EXEC SQL DROP DOMAIN cts1b.esal 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 " "
*initialise variables
MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxx" TO domn
MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxx" TO doms
*declare cursor to return rows from
*DOMAIN_CONSTRAINTS view
*WHERE clause added
*- ensures program still works if schema changes
DISPLAY "DECLARE data770 CURSOR FOR"
DISPLAY "SELECT DOMAIN_SCHEMA, DOMAIN_NAME"
DISPLAY "FROM INFORMATION_SCHEMA.DOMAIN_CONSTRAINTS"
DISPLAY "WHERE DOMAIN_NAME IN ('DOMSMALL', 'ESAL');"
EXEC SQL DECLARE data770 CURSOR FOR
SELECT DOMAIN_SCHEMA, DOMAIN_NAME
FROM INFORMATION_SCHEMA.DOMAIN_CONSTRAINTS
WHERE DOMAIN_NAME IN ('DOMSMALL', 'ESAL') END-EXEC
DISPLAY "OPEN data770;"
EXEC SQL OPEN data770 END-EXEC
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
.
P102.
DISPLAY " "
DISPLAY "FETCH data770 INTO :DOMS, :DOMN;"
EXEC SQL FETCH data770 INTO :DOMS, :DOMN END-EXEC
MOVE SQLCODE TO SQL-COD
PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
if (NORMSQ NOT = "00000") then
GO TO P101
END-IF
DISPLAY "Fetch executed successfully"
if (DOMS = "CTS1B" AND DOMN = "DOMSMALL") then
COMPUTE flag2 = flag2 - 1
DISPLAY "Found schema 'CTS1B' domain 'DOMSMALL'"
GO TO P102
END-IF
if (DOMS = "CTS1 " AND DOMN = "ESAL") then
DISPLAY "Found schema 'CTS1' domain 'ESAL'"
COMPUTE flag3 = flag3 - 1
GO TO P102
END-IF
DISPLAY "Incorrect schema and domain returned."
DISPLAY "Schema is ", DOMS, " and domain is ", DOMN
MOVE 0 TO flag
GO TO P102
.
P101.
DISPLAY "SQLCODE should be 100; its value is ", SQL-COD
DISPLAY "SQLSTATE should be 02000; its value is ", SQLSTATE
PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
if (SQLCODE NOT = 100 OR NORMSQ NOT = "02000") then
MOVE 0 TO flag
END-IF
if (NORMSQ = "02000" AND NORMSQ NOT = SQLSTATE)
then
DISPLAY "Valid implementation-defined SQLSTATE accepted."
END-IF
DISPLAY " "
*check both correct values were returned
if (flag2 NOT = 0 OR flag3 NOT = 0) then
DISPLAY "Incorrect DOMAIN_CONSTRAINT rows returned."
MOVE 0 TO flag
END-IF
*close the cursor
DISPLAY "CLOSE data770;"
EXEC SQL CLOSE data770 END-EXEC
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
*create domain cts1b.esal
*same specification as cts1.esal
*contains domain constraint
DISPLAY "COMMIT WORK;"
EXEC SQL COMMIT WORK END-EXEC
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "CREATE DOMAIN cts1b.esal AS INTEGER"
DISPLAY "CHECK (VALUE<500);"
* EXEC SQL CREATE DOMAIN cts1b.esal AS INTEGER
* CHECK (VALUE<500) 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 " "
*check that INFORMATION_SCHEMA.DOMAIN_CONSTRAINTS refers
*to cts1b.esal
MOVE 99 TO co
DISPLAY "SELECT COUNT (*) INTO :co"
DISPLAY "FROM INFORMATION_SCHEMA.DOMAIN_CONSTRAINTS"
DISPLAY "WHERE DOMAIN_NAME = 'ESAL';"
EXEC SQL SELECT COUNT (*) INTO :co
FROM INFORMATION_SCHEMA.DOMAIN_CONSTRAINTS
WHERE DOMAIN_NAME = 'ESAL' END-EXEC
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "co should be 2; its value is ", co
if (co NOT = 2) then
MOVE 0 TO flag
END-IF
*Drop the new domain
DISPLAY "COMMIT WORK;"
EXEC SQL COMMIT WORK END-EXEC
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "DROP DOMAIN cts1b.esal CASCADE;"
* EXEC SQL DROP DOMAIN cts1b.esal CASCADE END-EXEC
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
*commit work
DISPLAY "COMMIT WORK"
EXEC SQL COMMIT WORK END-EXEC
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
*check the dropped domain is no longer
*referenced in DOMAIN_CONSTRAINTS
MOVE 99 TO co
DISPLAY "SELECT COUNT (*) INTO :co"
DISPLAY "FROM INFORMATION_SCHEMA.DOMAIN_CONSTRAINTS"
DISPLAY "WHERE DOMAIN_NAME LIKE 'ESAL", ";"
EXEC SQL SELECT COUNT (*) INTO :co
FROM INFORMATION_SCHEMA.DOMAIN_CONSTRAINTS
WHERE DOMAIN_NAME LIKE 'ESAL%' END-EXEC
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "co should be 1; its value is ", co
if (co NOT = 1) then
MOVE 0 TO flag
END-IF
*determine rows in domain constraints which do not
*refer to a schema owned by the present
*authorisation identifier
MOVE 99 TO co
DISPLAY "SELECT COUNT (*) INTO :co"
DISPLAY "FROM INFORMATION_SCHEMA.DOMAIN_CONSTRAINTS"
DISPLAY "WHERE DOMAIN_SCHEMA NOT IN"
DISPLAY "('CTS1' ,'CTS1B');"
EXEC SQL SELECT COUNT (*) INTO :co
FROM INFORMATION_SCHEMA.DOMAIN_CONSTRAINTS
WHERE DOMAIN_SCHEMA NOT IN
('CTS1','CTS1B') END-EXEC
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "co should be 0; its value is ", co
if (co NOT = 0) then
MOVE 0 TO flag
END-IF
*ensure database is left in a consistent state
DISPLAY "COMMIT WORK;"
EXEC SQL COMMIT WORK END-EXEC
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "CREATE DOMAIN cts1b.esal AS INTEGER"
DISPLAY "CHECK (VALUE>500);"
* EXEC SQL CREATE DOMAIN cts1b.esal AS INTEGER
* CHECK (VALUE>500) 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 " "
if ( flag = 1 ) then
DISPLAY " yts770.pco *** pass *** "
EXEC SQL INSERT INTO CTS1.TESTREPORT
VALUES('7552','pass','PCO') END-EXEC
MOVE SQLCODE TO SQL-COD
else
DISPLAY " yts770.pco *** fail *** "
EXEC SQL INSERT INTO CTS1.TESTREPORT
VALUES('7552','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 TEST7552 ********************
**** 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.
|
