|
IDENTIFICATION DIVISION.
PROGRAM-ID. YTS750.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. xyz.
OBJECT-COMPUTER. xyz.
DATA DIVISION.
WORKING-STORAGE SECTION.
* Standard COBOL (file "YTS750.SCO") calling SQL
* procedures in file "YTS750.MCO".
*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
*
* YTS750.SCO
* WRITTEN BY: Susan Watters
* TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE
*
* CREATE DOMAIN as SQL procedure statement, no options
*
*
* REFERENCES
* 11.21 SR.1
* 11.21 GR.3
* 21.2.5 DOMAINS view
* F#25 Domain definition
* F#3 Basic schema manipulation
* F#2 Basic information schema
*
* DATE LAST ALTERED 02.01.96 CTS5 Hand-over Test
*
* QA Status: Full FC
*
* Revised by DWF 1996-02-29
* Added columns specified in TC2
* Fixed initializations
* Fixed indicator names
* Tightened pass criteria
* Upcased info schem identifier
* Removed EXEC SQL from inside printfs
* Removed superfluous code
* Fixed off-by-one
* Cleanups
* 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).
01 domcat PIC X(128).
01 dtype PIC X(29).
01 cnum PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 olen PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 colcat PIC X(128).
01 colnam PIC X(128).
01 colsch PIC X(128).
01 chrset PIC X(128).
01 chrsch PIC X(128).
01 chrnme PIC X(128).
01 domdef PIC X(256).
01 inttyp PIC X(128).
01 numpre PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 numrad PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 numscl PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 dttime PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 intpre PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 indic1 PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 indic2 PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 indic3 PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 indic4 PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 indic5 PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 indic6 PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 indic7 PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 indic8 PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 indic9 PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 indica PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 indicb PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 indicc PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 indicd PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 indice PIC S9(4) 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.
01 i PIC S9(4) 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, yts750.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 TEST7500 *******************
MOVE 1 TO flag
DISPLAY " TEST7500 "
DISPLAY " CREATE DOMAIN -SQL Procedure statement,no
- " options"
DISPLAY "References:"
DISPLAY " 11.21 SR.1"
DISPLAY " 11.21 GR.3"
DISPLAY " 21.2.5 DOMAINS view"
DISPLAY " TC #2 21.2.5 -- Interval columns added"
DISPLAY " F#25 Domain definition"
DISPLAY " F#3 Basic schema manipulation"
DISPLAY " F#2 Basic information schema"
DISPLAY " - - - - - - - - - - - - - - - - - - -"
COMPUTE SQLCODE = -1
MOVE "xxxxx" TO SQLSTATE
*initialise all host variables
MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxx" TO dtype
MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxx" TO colcat
MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxx" TO domcat
MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxx" TO colnam
MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxx" TO colsch
MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxx" TO chrset
MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxx" TO chrnme
MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxx" TO inttyp
MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
- "xxxxxxxxxxxxxxx" TO domdef
MOVE 99 TO indic1
MOVE 99 TO indic2
MOVE 99 TO indic3
MOVE 99 TO indic4
MOVE 99 TO indic5
MOVE 99 TO indic6
MOVE 99 TO indic7
MOVE 99 TO indic8
MOVE 99 TO indic9
MOVE 99 TO indica
MOVE 99 TO indicb
MOVE 99 TO indicc
MOVE 99 TO indicd
MOVE 99 TO indice
DISPLAY "CREATE DOMAIN intdomain INTEGER;"
* EXEC SQL CREATE DOMAIN intdomain INTEGER;
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 " "
MOVE 99 TO cnum
MOVE 99 TO olen
MOVE 99 TO numscl
MOVE 99 TO numrad
MOVE 99 TO intpre
DISPLAY "SELECT DOMAIN_CATALOG,"
DISPLAY " DATA_TYPE, CHARACTER_MAXIMUM_LENGTH,"
DISPLAY " CHARACTER_OCTET_LENGTH,
- " COLLATION_CATALOG,"
DISPLAY " COLLATION_SCHEMA, COLLATION_NAME,"
DISPLAY " CHARACTER_SET_CATALOG,
- " CHARACTER_SET_SCHEMA,"
DISPLAY " CHARACTER_SET_NAME, NUMERIC_PRECISION,"
DISPLAY " NUMERIC_PRECISION_RADIX, NUMERIC_SCALE,"
DISPLAY " DATETIME_PRECISION, DOMAIN_DEFAULT,"
DISPLAY " INTERVAL_TYPE, INTERVAL_PRECISION"
DISPLAY " INTO :domcat:indic1, :dtype,
- " :cnum:indic2,"
DISPLAY " :olen:indic3, :colcat:indic4,
- " :colsch:indic5,"
DISPLAY " :colnam:indic6, :chrset:indic7,
- " :chrsch:indic8,"
DISPLAY " :chrnme:indic9, :numpre:indica, :numrad,"
DISPLAY " :numscl, :dttime:indicb, :domdef:indicc,"
DISPLAY " :inttyp:indicd, :intpre:indice"
DISPLAY " FROM INFORMATION_SCHEMA.DOMAINS"
DISPLAY " WHERE DOMAIN_NAME = 'INTDOMAIN'"
DISPLAY " AND DOMAIN_SCHEMA = 'CTS1';"
* EXEC SQL SELECT DOMAIN_CATALOG,
* DATA_TYPE, CHARACTER_MAXIMUM_LENGTH,
* CHARACTER_OCTET_LENGTH, COLLATION_CATALOG,
* COLLATION_SCHEMA, COLLATION_NAME,
* CHARACTER_SET_CATALOG, CHARACTER_SET_SCHEMA,
* CHARACTER_SET_NAME, NUMERIC_PRECISION,
* NUMERIC_PRECISION_RADIX, NUMERIC_SCALE,
* DATETIME_PRECISION, DOMAIN_DEFAULT,
* INTERVAL_TYPE, INTERVAL_PRECISION
* INTO :domcat:indic1, :dtype, :cnum:indic2,
* :olen:indic3, :colcat:indic4, :colsch:indic5,
* :colnam:indic6, :chrset:indic7, :chrsch:indic8,
* :chrnme:indic9, :numpre:indica, :numrad,
* :numscl, :dttime:indicb, :domdef:indicc,
* :inttyp:indicd, :intpre:indice
* FROM INFORMATION_SCHEMA.DOMAINS
* WHERE DOMAIN_NAME = 'INTDOMAIN'
* AND DOMAIN_SCHEMA = 'CTS1';
CALL "SUB5" USING SQLCODE SQLSTATE domcat indic1 dtype cnum
indic2 olen indic3 colcat indic4 colsch indic5 colnam
indic6 chrset indic7 chrsch indic8 chrnme indic9 numpre
indica numrad numscl dttime indicb domdef indicc inttyp
indicd intpre indice
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "check value in DOMAIN_CATALOG is not NULL"
if (indic1 = -1) then
DISPLAY "NULL value incorrectly found for DOMAIN_CATALOG"
MOVE 0 TO flag
END-IF
DISPLAY " "
DISPLAY "check DATA_TYPE is INTEGER"
if (dtype NOT = "INTEGER") then
DISPLAY "Expected datatype INTEGER, found ", dtype
MOVE 0 TO flag
END-IF
DISPLAY " "
DISPLAY "check CHARACTER_MAXIMUM_LENGTH was NULL"
if (indic2 NOT = -1) then
DISPLAY "CHARACTER_MAXIMUM_LENGTH should be null"
DISPLAY "found ", cnum
MOVE 0 TO flag
END-IF
DISPLAY " "
DISPLAY "check CHARACTER_OCTET_LENGTH is NULL"
if (indic3 NOT = -1) then
DISPLAY "CHARACTER_OCTET_LENGTH should be null"
DISPLAY "value ", olen, " returned"
MOVE 0 TO flag
END-IF
DISPLAY " "
DISPLAY "check COLLATION_CATALOG is NULL"
if (indic4 NOT = -1) then
DISPLAY "COLLATION_CATALOG should be NULL"
DISPLAY "Value ", colcat, " returned"
MOVE 0 TO flag
END-IF
DISPLAY " "
DISPLAY "check COLLATION_SCHEMA is NULL"
if (indic5 NOT = -1) then
DISPLAY "COLLATION_SCHEMA should be NULL"
DISPLAY "Value ", colsch, " returned"
MOVE 0 TO flag
END-IF
DISPLAY " "
DISPLAY "check COLLATION_NAME is NULL"
if (indic6 NOT = -1) then
DISPLAY "COLLATION_NAME should be NULL"
DISPLAY "returned ", colnam
MOVE 0 TO flag
END-IF
DISPLAY " "
DISPLAY "check CHARACTER_SET_CATALOG is NULL"
if (indic7 NOT = -1) then
DISPLAY "CHARACTER_SET_CATALOG should be NULL"
DISPLAY "returned ", chrset
MOVE 0 TO flag
END-IF
DISPLAY " "
DISPLAY "check CHARACTER_SET_SCHEMA is NULL"
if (indic8 NOT = -1) then
DISPLAY "CHARACTER_SET_SCHEMA should be NULL"
DISPLAY "value ", chrsch, " returned"
MOVE 0 TO flag
END-IF
DISPLAY " "
DISPLAY "check CHARACTER_SET_NAME is NULL"
if (indic9 NOT = -1) then
DISPLAY "CHARACTER_SET_NAME should be NULL"
DISPLAY "Value ", chrnme, " returned"
MOVE 0 TO flag
END-IF
DISPLAY " "
DISPLAY "check value in NUMERIC_PRECISION is not NULL"
if (indica = -1) then
DISPLAY "NULL value incorrectly found for
- " NUMERIC_PRECISION"
MOVE 0 TO flag
END-IF
DISPLAY " "
DISPLAY "check value in NUMERIC_PRECISION_RADIX column "
DISPLAY "has a value in the set (2,10)"
if (2 NOT = numrad AND 10 NOT = numrad) then
DISPLAY "Expected NUMERIC_PRECISION_RADIX 2 or 10"
DISPLAY "Found ", numrad
MOVE 0 TO flag
END-IF
DISPLAY " "
DISPLAY "check NUMERIC_SCALE has value '0'"
if (numscl NOT = 0) then
DISPLAY "expected NUMERIC_SCALE 0, found ", numscl
MOVE 0 TO flag
END-IF
DISPLAY " "
DISPLAY "check DATETIME_PRECISION is NULL"
if (indicb NOT = -1) then
DISPLAY "DATETIME_PRECISION should be NULL"
DISPLAY "Value ", dttime, " returned"
MOVE 0 TO flag
END-IF
DISPLAY " "
DISPLAY "check value in DOMAIN_DEFAULT is null"
if (indicc NOT = -1) then
DISPLAY "DOMAIN_DEFAULT should be NULL"
DISPLAY "Value returned is ", domdef
END-IF
DISPLAY " "
DISPLAY "check value in INTERVAL_TYPE is null"
if (indicd NOT = -1) then
DISPLAY "INTERVAL_TYPE should be NULL"
DISPLAY "Value returned is ", inttyp
END-IF
DISPLAY " "
DISPLAY "check value in INTERVAL_PRECISION is null"
if (indice NOT = -1) then
DISPLAY "INTERVAL_PRECISION should be NULL"
DISPLAY "Value returned is ", intpre
END-IF
DISPLAY " "
DISPLAY "ROLLBACK WORK;"
* EXEC SQL ROLLBACK WORK;
CALL "SUB6" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "DROP DOMAIN intdomain CASCADE;"
* EXEC SQL DROP DOMAIN intdomain CASCADE;
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 " "
if ( flag = 1 ) then
DISPLAY " yts750.mco *** pass *** "
* EXEC SQL INSERT INTO CTS1.TESTREPORT
* VALUES('7500','pass','MCO');
CALL "SUB9" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " yts750.mco *** fail *** "
* EXEC SQL INSERT INTO CTS1.TESTREPORT
* VALUES('7500','fail','MCO');
CALL "SUB10" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB11" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
******************** END TEST7500 ********************
**** 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.31 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.
|
