|
IDENTIFICATION DIVISION.
PROGRAM-ID. DML152.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. xyz.
OBJECT-COMPUTER. xyz.
DATA DIVISION.
WORKING-STORAGE SECTION.
* Standard COBOL (file "DML152.SCO") calling SQL
* procedures in file "DML152.MCO".
****************************************************************
*
* COMMENT SECTION
*
* DATE 1994/7/11 STANDARD COBOL LANGUAGE
* NIST SQL VALIDATION TEST SUITE V6.0
* DISCLAIMER:
* This program was written by employees of NIST to test SQL
* implementations for conformance to the SQL standards.
* NIST assumes no responsibility for any party's use of
* this program.
*
* DML152.SCO
* WRITTEN BY: David W. Flater
* TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE
*
* This routine tests FIPS feature 12 (GET DIAGNOSTICS).
*
* REFERENCES
* FIPS PUB 127-2 14.1 Transitional SQL
* ANSI SQL-1992
*
****************************************************************
* 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 int1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 int2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 num PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 cmd PIC X(15).
01 st PIC X(5).
01 co PIC X(11).
01 sco PIC X(11).
01 nl1 PIC X(1).
01 nl2 PIC X(1).
01 nl3 PIC X(1).
01 nl4 PIC X(1).
01 nl5 PIC X(1).
01 mtxt PIC X(50).
01 mlen PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 omlen PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 olds PIC X(5).
01 snam PIC X(6).
01 tnam PIC X(5).
01 cnam PIC X(4).
* EXEC SQL END DECLARE SECTION END-EXEC
01 odsflg PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
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 "FLATER " TO uid
CALL "AUTHID" USING uid
MOVE "not logged in, not" TO uidx
* EXEC SQL SELECT USER INTO :uidx FROM HU.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, dml152.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 TEST0667 *******************
MOVE 1 TO flag
DISPLAY " TEST0667 "
DISPLAY " Diagnostics: access violations"
DISPLAY "References:"
DISPLAY " F# 12 -- Get diagnostics"
DISPLAY " 18.1 GR.3.g -- "
DISPLAY " - - - - - - - - - - - - - - - - - - -"
*Future work: figure out how to test GR.3.j
COMPUTE SQLCODE = -1
MOVE "xxxxx" TO SQLSTATE
*Subtest 1: No privileges
DISPLAY "SELECT COUNT(*) INTO :int1 FROM HU.STAFF2;"
* EXEC SQL SELECT COUNT(*) INTO :int1 FROM HU.STAFF2;
CALL "SUB3" USING SQLCODE SQLSTATE int1
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
MOVE SQLSTATE TO olds
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
MOVE 0 TO odsflg
if (NORMSQ = "42000" AND NORMSQ NOT = SQLSTATE)
then
DISPLAY "Valid implementation-defined SQLSTATE accepted."
MOVE 1 TO odsflg
END-IF
DISPLAY " "
*18.1 GR.3.g.i
COMPUTE int1 = -1
MOVE "xxxxx" TO st
MOVE "xxxxxxxxxxx" TO co
MOVE "xxxxxxxxxxx" TO sco
MOVE "x" TO nl1
MOVE "x" TO nl4
MOVE "x" TO nl5
MOVE "xxxxxx" TO snam
MOVE "xxxxx" TO tnam
MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
TO mtxt
COMPUTE mlen = -1
COMPUTE omlen = -1
DISPLAY "GET DIAGNOSTICS EXCEPTION 1"
DISPLAY " :int1 = CONDITION_NUMBER, :st =
- " RETURNED_SQLSTATE,"
DISPLAY " :co = CLASS_ORIGIN, :sco = SUBCLASS_ORIGIN,"
DISPLAY " :nl1 = CONSTRAINT_SCHEMA, :snam = SCHEMA_NAME,"
DISPLAY " :tnam = TABLE_NAME, :nl4 = COLUMN_NAME,"
DISPLAY " :nl5 = CURSOR_NAME, :mtxt = MESSAGE_TEXT,"
DISPLAY " :mlen = MESSAGE_LENGTH, :omlen =
- " MESSAGE_OCTET_LENGTH;"
* EXEC SQL GET DIAGNOSTICS EXCEPTION 1
* :int1 = CONDITION_NUMBER, :st = RETURNED_SQLSTATE,
* :co = CLASS_ORIGIN, :sco = SUBCLASS_ORIGIN,
* :nl1 = CONSTRAINT_SCHEMA, :snam = SCHEMA_NAME,
* :tnam = TABLE_NAME, :nl4 = COLUMN_NAME,
* :nl5 = CURSOR_NAME, :mtxt = MESSAGE_TEXT,
* :mlen = MESSAGE_LENGTH, :omlen = MESSAGE_OCTET_LENGTH
* ;
CALL "SUB4" USING SQLCODE SQLSTATE
int1 st co sco nl1 snam tnam nl4
nl5 mtxt mlen omlen
MOVE SQLCODE TO SQL-COD
DISPLAY "SQLCODE should be >= 0; its value is ", SQL-COD
if (SQLCODE < 0) then
MOVE 0 TO flag
END-IF
DISPLAY "SQLSTATE should be 01004; its value is ", SQLSTATE
PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
if (NORMSQ NOT = "01004") then
MOVE 0 TO flag
END-IF
DISPLAY "int1 should be 1; its value is ", int1
if (int1 NOT = 1) then
MOVE 0 TO flag
END-IF
DISPLAY "snam should be 'HU '; its value is '", snam "'"
if (snam NOT = "HU ") then
MOVE 0 TO flag
END-IF
DISPLAY "tnam should be 'STAFF' (STAFF2 won't fit); its
- " value is '", tnam "'"
if (tnam NOT = "STAFF") then
MOVE 0 TO flag
END-IF
DISPLAY "st should be ", olds "; its value is ", st
if (st NOT = olds) then
MOVE 0 TO flag
END-IF
DISPLAY "co should be 'ISO 9075 '; its value is ", co
if (co NOT = "ISO 9075 ") then
MOVE 0 TO flag
END-IF
if (odsflg = 1) then
GO TO P191
END-IF
DISPLAY "sco should be 'ISO 9075 '; its value is ", sco
if (sco NOT = "ISO 9075 ") then
MOVE 0 TO flag
END-IF
GO TO P190
.
P191.
DISPLAY "sco should NOT be 'ISO 9075 '; its value is ",
sco
if (sco = "ISO 9075 ") then
MOVE 0 TO flag
END-IF
.
P190.
DISPLAY "nl1 should be ' '; its value is '", nl1 "'"
if (nl1 NOT = " ") then
MOVE 0 TO flag
END-IF
DISPLAY "nl4 should be ' '; its value is '", nl4 "'"
if (nl4 NOT = " ") then
MOVE 0 TO flag
END-IF
DISPLAY "nl5 should be ' '; its value is '", nl5 "'"
if (nl5 NOT = " ") then
MOVE 0 TO flag
END-IF
DISPLAY "mtxt should be meaningful or blank; its value is
- " '", mtxt "'"
if (mtxt =
"xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") then
MOVE 0 TO flag
END-IF
DISPLAY "mlen should be >= 0; its value is ", mlen
DISPLAY "omlen should be >= 0; its value is ", omlen
if (mlen < 0 OR omlen < 0) then
MOVE 0 TO flag
END-IF
*Subtest 2: Read-only
DISPLAY "DELETE FROM HU.PROJ;"
* EXEC SQL DELETE FROM HU.PROJ;
CALL "SUB5" 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
MOVE SQLSTATE TO olds
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
MOVE 0 TO odsflg
if (NORMSQ = "42000" AND NORMSQ NOT = SQLSTATE)
then
DISPLAY "Valid implementation-defined SQLSTATE accepted."
MOVE 1 TO odsflg
END-IF
DISPLAY " "
COMPUTE int1 = -1
MOVE "xxxxx" TO st
MOVE "xxxxxxxxxxx" TO co
MOVE "xxxxxxxxxxx" TO sco
MOVE "x" TO nl1
MOVE "xxxxxx" TO snam
MOVE "xxxxx" TO tnam
MOVE "x" TO nl4
MOVE "x" TO nl5
MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
TO mtxt
COMPUTE mlen = -1
COMPUTE omlen = -1
DISPLAY "GET DIAGNOSTICS EXCEPTION 1"
DISPLAY " :int1 = CONDITION_NUMBER, :st =
- " RETURNED_SQLSTATE,"
DISPLAY " :co = CLASS_ORIGIN, :sco = SUBCLASS_ORIGIN,"
DISPLAY " :nl1 = CONSTRAINT_SCHEMA, :snam = SCHEMA_NAME,"
DISPLAY " :tnam = TABLE_NAME, :nl4 = COLUMN_NAME,"
DISPLAY " :nl5 = CURSOR_NAME, :mtxt = MESSAGE_TEXT,"
DISPLAY " :mlen = MESSAGE_LENGTH, :omlen =
- " MESSAGE_OCTET_LENGTH;"
* EXEC SQL GET DIAGNOSTICS EXCEPTION 1
* :int1 = CONDITION_NUMBER, :st = RETURNED_SQLSTATE,
* :co = CLASS_ORIGIN, :sco = SUBCLASS_ORIGIN,
* :nl1 = CONSTRAINT_SCHEMA, :snam = SCHEMA_NAME,
* :tnam = TABLE_NAME, :nl4 = COLUMN_NAME,
* :nl5 = CURSOR_NAME, :mtxt = MESSAGE_TEXT,
* :mlen = MESSAGE_LENGTH, :omlen = MESSAGE_OCTET_LENGTH
* ;
CALL "SUB6" USING SQLCODE SQLSTATE
int1 st co sco nl1 snam tnam nl4
nl5 mtxt mlen omlen
MOVE SQLCODE TO SQL-COD
DISPLAY "SQLCODE should be >= 0; its value is ", SQL-COD
if (SQLCODE < 0) then
MOVE 0 TO flag
END-IF
DISPLAY "SQLSTATE should be 00000 or 01004; its value is ",
SQLSTATE
PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
if (NORMSQ NOT = "00000" AND NORMSQ NOT =
"01004") then
MOVE 0 TO flag
END-IF
if (NORMSQ = "00000" AND NORMSQ NOT = SQLSTATE)
then
DISPLAY "Valid implementation-defined SQLSTATE accepted."
END-IF
DISPLAY "int1 should be 1; its value is ", int1
if (int1 NOT = 1) then
MOVE 0 TO flag
END-IF
DISPLAY "st should be ", olds "; its value is ", st
if (st NOT = olds) then
MOVE 0 TO flag
END-IF
DISPLAY "co should be 'ISO 9075 '; its value is ", co
if (co NOT = "ISO 9075 ") then
MOVE 0 TO flag
END-IF
if (odsflg = 1) then
GO TO P189
END-IF
DISPLAY "sco should be 'ISO 9075 '; its value is ", sco
if (sco NOT = "ISO 9075 ") then
MOVE 0 TO flag
END-IF
GO TO P188
.
P189.
DISPLAY "sco should NOT be 'ISO 9075 '; its value is ",
sco
if (sco = "ISO 9075 ") then
MOVE 0 TO flag
END-IF
.
P188.
DISPLAY "nl1 should be ' '; its value is '", nl1 "'"
if (nl1 NOT = " ") then
MOVE 0 TO flag
END-IF
DISPLAY "snam should be 'HU '; its value is '", snam "'"
if (snam NOT = "HU ") then
MOVE 0 TO flag
END-IF
DISPLAY "tnam should be 'PROJ '; its value is '", tnam "'"
if (tnam NOT = "PROJ ") then
MOVE 0 TO flag
END-IF
DISPLAY "nl4 should be ' '; its value is '", nl4 "'"
if (nl4 NOT = " ") then
MOVE 0 TO flag
END-IF
DISPLAY "nl5 should be ' '; its value is '", nl5 "'"
if (nl5 NOT = " ") then
MOVE 0 TO flag
END-IF
DISPLAY "mtxt should be meaningful or blank; its value is
- " '", mtxt "'"
if (mtxt =
"xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") then
MOVE 0 TO flag
END-IF
DISPLAY "mlen should be >= 0; its value is ", mlen
DISPLAY "omlen should be >= 0; its value is ", omlen
if (mlen < 0 OR omlen < 0) then
MOVE 0 TO flag
END-IF
*Subtest 3: Inaccessible column
DISPLAY "UPDATE HU.VTABLE SET COL2 = 5;"
* EXEC SQL UPDATE HU.VTABLE SET COL2 = 5;
CALL "SUB7" 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
MOVE SQLSTATE TO olds
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
MOVE 0 TO odsflg
if (NORMSQ = "42000" AND NORMSQ NOT = SQLSTATE)
then
DISPLAY "Valid implementation-defined SQLSTATE accepted."
MOVE 1 TO odsflg
END-IF
DISPLAY " "
COMPUTE int1 = -1
MOVE "xxxxx" TO st
MOVE "xxxxxxxxxxx" TO co
MOVE "xxxxxxxxxxx" TO sco
MOVE "x" TO nl1
MOVE "xxxxxx" TO snam
MOVE "xxxxx" TO tnam
MOVE "xxxx" TO cnam
MOVE "x" TO nl5
MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
TO mtxt
COMPUTE mlen = -1
COMPUTE omlen = -1
DISPLAY "GET DIAGNOSTICS EXCEPTION 1"
DISPLAY " :int1 = CONDITION_NUMBER, :st =
- " RETURNED_SQLSTATE,"
DISPLAY " :co = CLASS_ORIGIN, :sco = SUBCLASS_ORIGIN,"
DISPLAY " :nl1 = CONSTRAINT_SCHEMA, :snam = SCHEMA_NAME,"
DISPLAY " :tnam = TABLE_NAME, :cnam = COLUMN_NAME,"
DISPLAY " :nl5 = CURSOR_NAME, :mtxt = MESSAGE_TEXT,"
DISPLAY " :mlen = MESSAGE_LENGTH, :omlen =
- " MESSAGE_OCTET_LENGTH;"
* EXEC SQL GET DIAGNOSTICS EXCEPTION 1
* :int1 = CONDITION_NUMBER, :st = RETURNED_SQLSTATE,
* :co = CLASS_ORIGIN, :sco = SUBCLASS_ORIGIN,
* :nl1 = CONSTRAINT_SCHEMA, :snam = SCHEMA_NAME,
* :tnam = TABLE_NAME, :cnam = COLUMN_NAME,
* :nl5 = CURSOR_NAME, :mtxt = MESSAGE_TEXT,
* :mlen = MESSAGE_LENGTH, :omlen = MESSAGE_OCTET_LENGTH
* ;
CALL "SUB8" USING SQLCODE SQLSTATE
int1 st co sco nl1 snam tnam cnam
nl5 mtxt mlen omlen
MOVE SQLCODE TO SQL-COD
DISPLAY "SQLCODE should be >= 0; its value is ", SQL-COD
if (SQLCODE < 0) then
MOVE 0 TO flag
END-IF
DISPLAY "(tnam is one character too short)"
DISPLAY "SQLSTATE should be 01004; its value is ", SQLSTATE
if (NORMSQ NOT = "01004") then
MOVE 0 TO flag
END-IF
DISPLAY "int1 should be 1; its value is ", int1
if (int1 NOT = 1) then
MOVE 0 TO flag
END-IF
DISPLAY "st should be ", olds "; its value is ", st
if (st NOT = olds) then
MOVE 0 TO flag
END-IF
DISPLAY "co should be 'ISO 9075 '; its value is ", co
if (co NOT = "ISO 9075 ") then
MOVE 0 TO flag
END-IF
if (odsflg = 1) then
GO TO P187
END-IF
DISPLAY "sco should be 'ISO 9075 '; its value is ", sco
if (sco NOT = "ISO 9075 ") then
MOVE 0 TO flag
END-IF
GO TO P186
.
P187.
DISPLAY "sco should NOT be 'ISO 9075 '; its value is ",
sco
if (sco = "ISO 9075 ") then
MOVE 0 TO flag
END-IF
.
P186.
DISPLAY "nl1 should be ' '; its value is '", nl1 "'"
if (nl1 NOT = " ") then
MOVE 0 TO flag
END-IF
DISPLAY "snam should be 'HU '; its value is '", snam "'"
if (snam NOT = "HU ") then
MOVE 0 TO flag
END-IF
DISPLAY "tnam should be 'VTABL'; its value is '", tnam "'"
if (tnam NOT = "VTABL") then
MOVE 0 TO flag
END-IF
DISPLAY "cnam should be 'COL2'; its value is '", cnam "'"
if (cnam NOT = "COL2") then
MOVE 0 TO flag
END-IF
DISPLAY "nl5 should be ' '; its value is '", nl5 "'"
if (nl5 NOT = " ") then
MOVE 0 TO flag
END-IF
DISPLAY "mtxt should be meaningful or blank; its value is
- " '", mtxt "'"
if (mtxt =
"xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") then
MOVE 0 TO flag
END-IF
DISPLAY "mlen should be >= 0; its value is ", mlen
DISPLAY "omlen should be >= 0; its value is ", omlen
if (mlen < 0 OR omlen < 0) then
MOVE 0 TO flag
END-IF
*Subtest 4: Partially accessible column
*The following GRANT was added to SCHEMA1 for this subtest:
* GRANT UPDATE (COL1) ON VTABLE TO FLATER
*Can't do a searched update without SELECT privilege
DISPLAY "UPDATE HU.VTABLE SET COL1 = 5"
DISPLAY " WHERE COL1 = 0;"
* EXEC SQL UPDATE HU.VTABLE SET COL1 = 5
* WHERE COL1 = 0;
CALL "SUB9" 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
MOVE SQLSTATE TO olds
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
MOVE 0 TO odsflg
if (NORMSQ = "42000" AND NORMSQ NOT = SQLSTATE)
then
DISPLAY "Valid implementation-defined SQLSTATE accepted."
MOVE 1 TO odsflg
END-IF
DISPLAY " "
COMPUTE int1 = -1
MOVE "xxxxx" TO st
MOVE "xxxxxxxxxxx" TO co
MOVE "xxxxxxxxxxx" TO sco
MOVE "x" TO nl1
MOVE "xxxxxx" TO snam
MOVE "xxxxx" TO tnam
MOVE "xxxx" TO cnam
MOVE "x" TO nl5
MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
TO mtxt
COMPUTE mlen = -1
COMPUTE omlen = -1
DISPLAY "GET DIAGNOSTICS EXCEPTION 1"
DISPLAY " :int1 = CONDITION_NUMBER, :st =
- " RETURNED_SQLSTATE,"
DISPLAY " :co = CLASS_ORIGIN, :sco = SUBCLASS_ORIGIN,"
DISPLAY " :nl1 = CONSTRAINT_SCHEMA, :snam = SCHEMA_NAME,"
DISPLAY " :tnam = TABLE_NAME, :cnam = COLUMN_NAME,"
DISPLAY " :nl5 = CURSOR_NAME, :mtxt = MESSAGE_TEXT,"
DISPLAY " :mlen = MESSAGE_LENGTH, :omlen =
- " MESSAGE_OCTET_LENGTH;"
* EXEC SQL GET DIAGNOSTICS EXCEPTION 1
* :int1 = CONDITION_NUMBER, :st = RETURNED_SQLSTATE,
* :co = CLASS_ORIGIN, :sco = SUBCLASS_ORIGIN,
* :nl1 = CONSTRAINT_SCHEMA, :snam = SCHEMA_NAME,
* :tnam = TABLE_NAME, :cnam = COLUMN_NAME,
* :nl5 = CURSOR_NAME, :mtxt = MESSAGE_TEXT,
* :mlen = MESSAGE_LENGTH, :omlen = MESSAGE_OCTET_LENGTH
* ;
CALL "SUB10" USING SQLCODE SQLSTATE
int1 st co sco nl1 snam tnam
cnam nl5 mtxt mlen omlen
MOVE SQLCODE TO SQL-COD
DISPLAY "SQLCODE should be >= 0; its value is ", SQL-COD
if (SQLCODE < 0) then
MOVE 0 TO flag
END-IF
DISPLAY "(tnam is one character too short)"
DISPLAY "SQLSTATE should be 01004; its value is ", SQLSTATE
if (NORMSQ NOT = "01004") then
MOVE 0 TO flag
END-IF
DISPLAY "int1 should be 1; its value is ", int1
if (int1 NOT = 1) then
MOVE 0 TO flag
END-IF
DISPLAY "st should be ", olds "; its value is ", st
if (st NOT = olds) then
MOVE 0 TO flag
END-IF
DISPLAY "co should be 'ISO 9075 '; its value is ", co
if (co NOT = "ISO 9075 ") then
MOVE 0 TO flag
END-IF
if (odsflg = 1) then
GO TO P185
END-IF
DISPLAY "sco should be 'ISO 9075 '; its value is ", sco
if (sco NOT = "ISO 9075 ") then
MOVE 0 TO flag
END-IF
GO TO P184
.
P185.
DISPLAY "sco should NOT be 'ISO 9075 '; its value is ",
sco
if (sco = "ISO 9075 ") then
MOVE 0 TO flag
END-IF
.
P184.
DISPLAY "nl1 should be ' '; its value is '", nl1 "'"
if (nl1 NOT = " ") then
MOVE 0 TO flag
END-IF
DISPLAY "snam should be 'HU '; its value is '", snam "'"
if (snam NOT = "HU ") then
MOVE 0 TO flag
END-IF
DISPLAY "tnam should be 'VTABL'; its value is '", tnam "'"
if (tnam NOT = "VTABL") then
MOVE 0 TO flag
END-IF
DISPLAY "cnam should be 'COL1'; its value is '", cnam "'"
if (cnam NOT = "COL1") then
MOVE 0 TO flag
END-IF
DISPLAY "nl5 should be ' '; its value is '", nl5 "'"
if (nl5 NOT = " ") then
MOVE 0 TO flag
END-IF
DISPLAY "mtxt should be meaningful or blank; its value is
- " '", mtxt "'"
if (mtxt =
"xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") then
MOVE 0 TO flag
END-IF
DISPLAY "mlen should be >= 0; its value is ", mlen
DISPLAY "omlen should be >= 0; its value is ", omlen
if (mlen < 0 OR omlen < 0) then
MOVE 0 TO flag
END-IF
DISPLAY "ROLLBACK WORK;"
* EXEC SQL ROLLBACK WORK;
CALL "SUB11" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
if ( flag = 1 ) then
DISPLAY " *** pass *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0667','pass','MCO');
CALL "SUB12" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " dml152.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0667','fail','MCO');
CALL "SUB13" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB14" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
******************** END TEST0667 ********************
******************** BEGIN TEST0668 *******************
MOVE 1 TO flag
DISPLAY " TEST0668 "
DISPLAY " Diagnostics: COMMAND_FUNCTION (static)"
DISPLAY "References:"
DISPLAY " F# 12 -- Get diagnostics"
DISPLAY " 18.1 -- "
DISPLAY " TC #2 18.1 -- unrecognized statements"
DISPLAY " - - - - - - - - - - - - - - - - - - -"
COMPUTE SQLCODE = -1
MOVE "xxxxx" TO SQLSTATE
*COMMIT WORK
*Even if we get an invalid transaction state it should still
*set COMMAND_FUNCTION
DISPLAY "COMMIT WORK;"
* EXEC SQL COMMIT WORK;
CALL "SUB15" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
*This verifies that GET DIAGNOSTICS sets SQLSTATE
COMPUTE SQLCODE = -1
MOVE "xxxxx" TO SQLSTATE
MOVE "xxxxxxxxxxxxxxx" TO cmd
DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
* EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
CALL "SUB16" USING SQLCODE SQLSTATE cmd
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "cmd should be 'COMMIT WORK '; its value is ",
cmd
if (cmd NOT = "COMMIT WORK ") then
MOVE 0 TO flag
END-IF
*SELECT
DISPLAY "SELECT COUNT(*) INTO :int1 FROM USIG;"
* EXEC SQL SELECT COUNT(*) INTO :int1 FROM USIG;
CALL "SUB17" USING SQLCODE SQLSTATE int1
MOVE SQLCODE TO SQL-COD
MOVE "xxxxxxxxxxxxxxx" TO cmd
DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
* EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
CALL "SUB18" USING SQLCODE SQLSTATE cmd
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "cmd should be 'SELECT '; its value is ",
cmd
if (cmd NOT = "SELECT ") then
MOVE 0 TO flag
END-IF
*DELETE WHERE
DISPLAY "DELETE FROM CONCATBUF;"
* EXEC SQL DELETE FROM CONCATBUF;
CALL "SUB19" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
MOVE "xxxxxxxxxxxxxxx" TO cmd
DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
* EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
CALL "SUB20" USING SQLCODE SQLSTATE cmd
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "cmd should be 'DELETE WHERE '; its value is ",
cmd
if (cmd NOT = "DELETE WHERE ") then
MOVE 0 TO flag
END-IF
*INSERT
DISPLAY "INSERT INTO CONCATBUF VALUES ('fnord');"
* EXEC SQL INSERT INTO CONCATBUF VALUES ('fnord');
CALL "SUB21" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
MOVE "xxxxxxxxxxxxxxx" TO cmd
DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
* EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
CALL "SUB22" USING SQLCODE SQLSTATE cmd
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "cmd should be 'INSERT '; its value is ",
cmd
if (cmd NOT = "INSERT ") then
MOVE 0 TO flag
END-IF
*UPDATE WHERE
DISPLAY "UPDATE CONCATBUF SET ZZ = 'moby'"
DISPLAY " WHERE ZZ = 'fnord';"
* EXEC SQL UPDATE CONCATBUF SET ZZ = 'moby'
* WHERE ZZ = 'fnord';
CALL "SUB23" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
MOVE "xxxxxxxxxxxxxxx" TO cmd
DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
* EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
CALL "SUB24" USING SQLCODE SQLSTATE cmd
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "cmd should be 'UPDATE WHERE '; its value is ",
cmd
if (cmd NOT = "UPDATE WHERE ") then
MOVE 0 TO flag
END-IF
*OPEN
DISPLAY "DECLARE C12741 CURSOR FOR"
DISPLAY " SELECT ZZ FROM CONCATBUF;"
* EXEC SQL DECLARE C12741 CURSOR FOR
* SELECT ZZ FROM CONCATBUF END-EXEC
DISPLAY "OPEN C12741;"
* EXEC SQL OPEN C12741;
CALL "SUB25" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
MOVE "xxxxxxxxxxxxxxx" TO cmd
DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
* EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
CALL "SUB26" USING SQLCODE SQLSTATE cmd
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "cmd should be 'OPEN '; its value is ",
cmd
if (cmd NOT = "OPEN ") then
MOVE 0 TO flag
END-IF
*FETCH
DISPLAY "FETCH C12741 INTO :cmd;"
* EXEC SQL FETCH C12741 INTO :cmd;
CALL "SUB27" USING SQLCODE SQLSTATE cmd
MOVE SQLCODE TO SQL-COD
MOVE "xxxxxxxxxxxxxxx" TO cmd
DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
* EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
CALL "SUB28" USING SQLCODE SQLSTATE cmd
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "cmd should be 'FETCH '; its value is ",
cmd
if (cmd NOT = "FETCH ") then
MOVE 0 TO flag
END-IF
*UPDATE CURSOR
DISPLAY "UPDATE CONCATBUF"
DISPLAY " SET ZZ = 'clobber' WHERE CURRENT OF C12741;"
* EXEC SQL UPDATE CONCATBUF
* SET ZZ = 'clobber' WHERE CURRENT OF C12741;
CALL "SUB29" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
MOVE "xxxxxxxxxxxxxxx" TO cmd
DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
* EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
CALL "SUB30" USING SQLCODE SQLSTATE cmd
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "cmd should be 'UPDATE CURSOR '; its value is ",
cmd
if (cmd NOT = "UPDATE CURSOR ") then
MOVE 0 TO flag
END-IF
*DELETE CURSOR (<delete statement: positioned>)
DISPLAY "DELETE FROM CONCATBUF WHERE CURRENT OF C12741;"
* EXEC SQL DELETE FROM CONCATBUF WHERE CURRENT OF C12741
* ;
CALL "SUB31" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
MOVE "xxxxxxxxxxxxxxx" TO cmd
DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
* EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
CALL "SUB32" USING SQLCODE SQLSTATE cmd
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "cmd should be 'DELETE CURSOR '; its value is ",
cmd
if (cmd NOT = "DELETE CURSOR ") then
MOVE 0 TO flag
END-IF
*CLOSE CURSOR
DISPLAY "CLOSE C12741;"
* EXEC SQL CLOSE C12741;
CALL "SUB33" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
MOVE "xxxxxxxxxxxxxxx" TO cmd
DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
* EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
CALL "SUB34" USING SQLCODE SQLSTATE cmd
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "cmd should be 'CLOSE CURSOR '; its value is ",
cmd
if (cmd NOT = "CLOSE CURSOR ") then
MOVE 0 TO flag
END-IF
*Unrecognized statement: TC #2 18.1
*If your database recognizes FROB, change it to a command
*that it doesn't recognize. If unrecognized statements are
*rejected at compile time, TEd this part out.
DISPLAY "FROB;"
* EXEC SQL FROB;
CALL "SUB35" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
MOVE "xxxxxxxxxxxxxxx" TO cmd
DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
* EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
CALL "SUB36" USING SQLCODE SQLSTATE cmd
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "cmd should be ' '; its value is '", cmd "'"
if (cmd NOT = " ") then
MOVE 0 TO flag
END-IF
*ROLLBACK WORK
DISPLAY "ROLLBACK WORK;"
* EXEC SQL ROLLBACK WORK;
CALL "SUB37" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
MOVE "xxxxxxxxxxxxxxx" TO cmd
DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
* EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
CALL "SUB38" USING SQLCODE SQLSTATE cmd
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "cmd should be 'ROLLBACK WORK '; its value is ",
cmd
if (cmd NOT = "ROLLBACK WORK ") then
MOVE 0 TO flag
END-IF
*For future reference: these cannot be tested in Trans SQL
*ALLOCATE CURSOR: Full SQL
*ALTER DOMAIN: Intermediate SQL
*CREATE ASSERTION: Full SQL
*CREATE CHARACTER SET: Intermediate SQL
*CREATE COLLATION: Full SQL
*CONNECT: Full SQL
*DEALLOCATE PREPARE: Full SQL
*DISCONNECT: Full SQL
*CREATE DOMAIN: Intermediate SQL
*DROP ASSERTION: Full SQL
*DROP CHARACTER SET: Intermediate SQL
*DROP COLLATION: Full SQL
*DROP DOMAIN: Intermediate SQL
*DROP SCHEMA: Intermediate SQL
*DROP TRANSLATION: Full SQL
*CREATE SCHEMA: Intermediate SQL
*SET CATALOG: Full SQL
*SET CONNECTION: Full SQL
*SET CONSTRAINT: Full SQL
*SET TIME ZONE: Intermediate SQL
*SET NAMES: Full SQL
*SET SCHEMA: Full SQL
*SET SESSION AUTHORIZATION: Intermediate SQL
*CREATE TRANSLATION: Full SQL
*GET DIAGNOSTICS F# 12 Can't happen
if ( flag = 1 ) then
DISPLAY " *** pass *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0668','pass','MCO');
CALL "SUB39" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " dml152.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0668','fail','MCO');
CALL "SUB40" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB41" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
******************** END TEST0668 ********************
******************** BEGIN TEST0669 *******************
MOVE 1 TO flag
DISPLAY " TEST0669 "
DISPLAY "Diagnostics: COMMAND_FUNCTION F# 3, 11"
DISPLAY "References:"
DISPLAY " F# 12 -- Get diagnostics"
DISPLAY " 18.1 -- "
DISPLAY " - - - - - - - - - - - - - - - - - - -"
COMPUTE SQLCODE = -1
MOVE "xxxxx" TO SQLSTATE
*SET TRANSACTION F# 11
DISPLAY "SET TRANSACTION ISOLATION LEVEL SERIALIZABLE;"
* EXEC SQL SET TRANSACTION ISOLATION LEVEL SERIALIZABLE
* ;
CALL "SUB42" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
MOVE "xxxxxxxxxxxxxxx" TO cmd
DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
* EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
CALL "SUB43" USING SQLCODE SQLSTATE cmd
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "cmd should be 'SET TRANSACTION'; its value is ",
cmd
if (cmd NOT = "SET TRANSACTION") then
MOVE 0 TO flag
END-IF
*CREATE VIEW F# 3
DISPLAY "CREATE VIEW BEABLE AS"
DISPLAY " SELECT ZZ FROM CONCATBUF;"
* EXEC SQL CREATE VIEW BEABLE AS
* SELECT ZZ FROM CONCATBUF;
CALL "SUB44" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
MOVE "xxxxxxxxxxxxxxx" TO cmd
DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
* EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
CALL "SUB45" USING SQLCODE SQLSTATE cmd
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "cmd should be 'CREATE VIEW '; its value is ",
cmd
if (cmd NOT = "CREATE VIEW ") then
MOVE 0 TO flag
END-IF
*CREATE TABLE F# 3
DISPLAY "CREATE TABLE SLACK ("
DISPLAY " NAAM CHAR (10), DONATION DECIMAL (5, 2));"
* EXEC SQL CREATE TABLE SLACK (
* NAAM CHAR (10), DONATION DECIMAL (5, 2));
CALL "SUB46" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
MOVE "xxxxxxxxxxxxxxx" TO cmd
DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
* EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
CALL "SUB47" USING SQLCODE SQLSTATE cmd
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "cmd should be 'CREATE TABLE '; its value is ",
cmd
if (cmd NOT = "CREATE TABLE ") then
MOVE 0 TO flag
END-IF
*ALTER TABLE F# 3
DISPLAY "ALTER TABLE SLACK"
DISPLAY " ADD COLUMN KIBO_NUMBER INT;"
* EXEC SQL ALTER TABLE SLACK
* ADD COLUMN KIBO_NUMBER INT;
CALL "SUB48" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
MOVE "xxxxxxxxxxxxxxx" TO cmd
DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
* EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
CALL "SUB49" USING SQLCODE SQLSTATE cmd
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "cmd should be 'ALTER TABLE '; its value is ",
cmd
if (cmd NOT = "ALTER TABLE ") then
MOVE 0 TO flag
END-IF
*GRANT F# 3
DISPLAY "GRANT ALL PRIVILEGES ON SLACK TO PUBLIC;"
* EXEC SQL GRANT ALL PRIVILEGES ON SLACK TO PUBLIC;
CALL "SUB50" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
MOVE "xxxxxxxxxxxxxxx" TO cmd
DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
* EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
CALL "SUB51" USING SQLCODE SQLSTATE cmd
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "cmd should be 'GRANT '; its value is ",
cmd
if (cmd NOT = "GRANT ") then
MOVE 0 TO flag
END-IF
*REVOKE F# 3
DISPLAY "REVOKE INSERT ON SLACK FROM PUBLIC CASCADE;"
* EXEC SQL REVOKE INSERT ON SLACK FROM PUBLIC CASCADE
* ;
CALL "SUB52" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
MOVE "xxxxxxxxxxxxxxx" TO cmd
DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
* EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
CALL "SUB53" USING SQLCODE SQLSTATE cmd
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "cmd should be 'REVOKE '; its value is ",
cmd
if (cmd NOT = "REVOKE ") then
MOVE 0 TO flag
END-IF
*DROP TABLE F# 3
DISPLAY "DROP TABLE SLACK RESTRICT;"
* EXEC SQL DROP TABLE SLACK RESTRICT;
CALL "SUB54" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
MOVE "xxxxxxxxxxxxxxx" TO cmd
DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
* EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
CALL "SUB55" USING SQLCODE SQLSTATE cmd
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "cmd should be 'DROP TABLE '; its value is ",
cmd
if (cmd NOT = "DROP TABLE ") then
MOVE 0 TO flag
END-IF
*DROP VIEW F# 3
DISPLAY "DROP VIEW BEABLE RESTRICT;"
* EXEC SQL DROP VIEW BEABLE RESTRICT;
CALL "SUB56" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
MOVE "xxxxxxxxxxxxxxx" TO cmd
DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
* EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
CALL "SUB57" USING SQLCODE SQLSTATE cmd
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "cmd should be 'DROP VIEW '; its value is ",
cmd
if (cmd NOT = "DROP VIEW ") then
MOVE 0 TO flag
END-IF
DISPLAY "ROLLBACK WORK;"
* EXEC SQL ROLLBACK WORK;
CALL "SUB58" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
if ( flag = 1 ) then
DISPLAY " *** pass *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0669','pass','MCO');
CALL "SUB59" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " dml152.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0669','fail','MCO');
CALL "SUB60" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB61" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
******************** END TEST0669 ********************
******************** BEGIN TEST0672 *******************
MOVE 1 TO flag
DISPLAY " TEST0672 "
DISPLAY " Diagnostics: Multiple conditions"
DISPLAY "References:"
DISPLAY " F# 12 -- Get diagnostics"
DISPLAY " F# 11 -- Transaction isolation"
DISPLAY " 18.1 -- "
DISPLAY " TC #2 4.18.1 -- precedence rules for SQLSTATE"
DISPLAY " - - - - - - - - - - - - - - - - - - -"
COMPUTE SQLCODE = -1
MOVE "xxxxx" TO SQLSTATE
DISPLAY "CREATE TABLE DOUBLE_TROUBLE ("
DISPLAY " TOO_LITTLE CHAR (10), TOO_LATE CHAR (10));"
* EXEC SQL CREATE TABLE DOUBLE_TROUBLE (
* TOO_LITTLE CHAR (10), TOO_LATE CHAR (10));
CALL "SUB62" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "COMMIT WORK;"
* EXEC SQL COMMIT WORK;
CALL "SUB63" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "INSERT INTO DOUBLE_TROUBLE VALUES ('Albatross!',
- " NULL);"
* EXEC SQL INSERT INTO DOUBLE_TROUBLE VALUES ('Albatross!',
* NULL);
CALL "SUB64" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "COMMIT WORK;"
* EXEC SQL COMMIT WORK;
CALL "SUB65" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
MOVE 2 TO int1
DISPLAY "int1 = 2"
DISPLAY "SET TRANSACTION DIAGNOSTICS SIZE :int1;"
* EXEC SQL SET TRANSACTION DIAGNOSTICS SIZE :int1;
CALL "SUB66" USING SQLCODE SQLSTATE int1
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
*Simultaneously generate a string data, right truncation warning
*and a null value, no indicator parameter exception. Since one
*is a warning and the other is an error, we know what order they
*should be in. See TC #2 4.18.1.
DISPLAY "SELECT * INTO :nl1, :mtxt FROM DOUBLE_TROUBLE;"
* EXEC SQL SELECT * INTO :nl1, :mtxt FROM DOUBLE_TROUBLE
* ;
CALL "SUB67" USING SQLCODE SQLSTATE nl1 mtxt
MOVE SQLCODE TO SQL-COD
DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
DISPLAY "SQLSTATE should be 22002; its value is ", SQLSTATE
if (SQLSTATE NOT = "22002") then
MOVE 0 TO flag
END-IF
COMPUTE num = -1
DISPLAY "GET DIAGNOSTICS :num = NUMBER;"
* EXEC SQL GET DIAGNOSTICS :num = NUMBER;
CALL "SUB68" USING SQLCODE SQLSTATE num
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "num should be 1 or 2; its value is ", num
if (num NOT = 2 AND num NOT = 1) then
MOVE 0 TO flag
END-IF
COMPUTE int1 = -1
MOVE "xxxxx" TO st
MOVE "xxxxxxxxxxx" TO co
MOVE "xxxxxxxxxxx" TO sco
MOVE "x" TO nl1
MOVE "x" TO nl2
MOVE "x" TO nl3
MOVE "x" TO nl4
MOVE "x" TO nl5
MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
TO mtxt
COMPUTE mlen = -1
COMPUTE omlen = -1
DISPLAY "GET DIAGNOSTICS EXCEPTION 1"
DISPLAY " :int1 = CONDITION_NUMBER, :st =
- " RETURNED_SQLSTATE,"
DISPLAY " :co = CLASS_ORIGIN, :sco = SUBCLASS_ORIGIN,"
DISPLAY " :nl1 = CONSTRAINT_SCHEMA, :nl2 = SCHEMA_NAME,"
DISPLAY " :nl3 = TABLE_NAME, :nl4 = COLUMN_NAME,"
DISPLAY " :nl5 = CURSOR_NAME, :mtxt = MESSAGE_TEXT,"
DISPLAY " :mlen = MESSAGE_LENGTH, :omlen =
- " MESSAGE_OCTET_LENGTH;"
* EXEC SQL GET DIAGNOSTICS EXCEPTION 1
* :int1 = CONDITION_NUMBER, :st = RETURNED_SQLSTATE,
* :co = CLASS_ORIGIN, :sco = SUBCLASS_ORIGIN,
* :nl1 = CONSTRAINT_SCHEMA, :nl2 = SCHEMA_NAME,
* :nl3 = TABLE_NAME, :nl4 = COLUMN_NAME,
* :nl5 = CURSOR_NAME, :mtxt = MESSAGE_TEXT,
* :mlen = MESSAGE_LENGTH, :omlen = MESSAGE_OCTET_LENGTH
* ;
CALL "SUB69" USING SQLCODE SQLSTATE
int1 st co sco nl1 nl2 nl3 nl4
nl5 mtxt mlen omlen
MOVE SQLCODE TO SQL-COD
DISPLAY "SQLCODE should be >= 0; its value is ", SQL-COD
if (SQLCODE < 0) then
MOVE 0 TO flag
END-IF
DISPLAY "SQLSTATE should be 00000 or 01004; its value is ",
SQLSTATE
PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
if (NORMSQ NOT = "00000" AND NORMSQ NOT =
"01004") then
MOVE 0 TO flag
END-IF
if (NORMSQ = "00000" AND NORMSQ NOT = SQLSTATE)
then
DISPLAY "Valid implementation-defined SQLSTATE accepted."
END-IF
DISPLAY "int1 should be 1; its value is ", int1
if (int1 NOT = 1) then
MOVE 0 TO flag
END-IF
DISPLAY "st should be 22002; its value is ", st
if (st NOT = "22002") then
MOVE 0 TO flag
END-IF
DISPLAY "co should be 'ISO 9075 '; its value is ", co
if (co NOT = "ISO 9075 ") then
MOVE 0 TO flag
END-IF
DISPLAY "sco should be 'ISO 9075 '; its value is ", sco
if (sco NOT = "ISO 9075 ") then
MOVE 0 TO flag
END-IF
DISPLAY "nl1 should be ' '; its value is '", nl1 "'"
if (nl1 NOT = " ") then
MOVE 0 TO flag
END-IF
DISPLAY "nl2 should be ' '; its value is '", nl2 "'"
if (nl2 NOT = " ") then
MOVE 0 TO flag
END-IF
DISPLAY "nl3 should be ' '; its value is '", nl3 "'"
if (nl3 NOT = " ") then
MOVE 0 TO flag
END-IF
DISPLAY "nl4 should be ' '; its value is '", nl4 "'"
if (nl4 NOT = " ") then
MOVE 0 TO flag
END-IF
DISPLAY "nl5 should be ' '; its value is '", nl5 "'"
if (nl5 NOT = " ") then
MOVE 0 TO flag
END-IF
DISPLAY "mtxt should be meaningful or blank; its value is
- " '", mtxt "'"
if (mtxt =
"xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") then
MOVE 0 TO flag
END-IF
DISPLAY "mlen should be >= 0; its value is ", mlen
DISPLAY "omlen should be >= 0; its value is ", omlen
if (mlen < 0 OR omlen < 0) then
MOVE 0 TO flag
END-IF
if (num = 1) then
DISPLAY "Skipping rest of test because NUMBER = 1"
GO TO P183
END-IF
COMPUTE int1 = -1
MOVE 2 TO int2
DISPLAY "int2 = 2"
MOVE "xxxxx" TO st
MOVE "xxxxxxxxxxx" TO co
MOVE "xxxxxxxxxxx" TO sco
MOVE "x" TO nl1
MOVE "x" TO nl2
MOVE "x" TO nl3
MOVE "x" TO nl4
MOVE "x" TO nl5
MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
TO mtxt
COMPUTE mlen = -1
COMPUTE omlen = -1
DISPLAY "GET DIAGNOSTICS EXCEPTION :int2"
DISPLAY " :int1 = CONDITION_NUMBER, :st =
- " RETURNED_SQLSTATE,"
DISPLAY " :co = CLASS_ORIGIN, :sco = SUBCLASS_ORIGIN,"
DISPLAY " :nl1 = CONSTRAINT_SCHEMA, :nl2 = SCHEMA_NAME,"
DISPLAY " :nl3 = TABLE_NAME, :nl4 = COLUMN_NAME,"
DISPLAY " :nl5 = CURSOR_NAME, :mtxt = MESSAGE_TEXT,"
DISPLAY " :mlen = MESSAGE_LENGTH, :omlen =
- " MESSAGE_OCTET_LENGTH;"
* EXEC SQL GET DIAGNOSTICS EXCEPTION :int2
* :int1 = CONDITION_NUMBER, :st = RETURNED_SQLSTATE,
* :co = CLASS_ORIGIN, :sco = SUBCLASS_ORIGIN,
* :nl1 = CONSTRAINT_SCHEMA, :nl2 = SCHEMA_NAME,
* :nl3 = TABLE_NAME, :nl4 = COLUMN_NAME,
* :nl5 = CURSOR_NAME, :mtxt = MESSAGE_TEXT,
* :mlen = MESSAGE_LENGTH, :omlen = MESSAGE_OCTET_LENGTH
* ;
CALL "SUB70" USING SQLCODE SQLSTATE
int2 int1 st co sco nl1 nl2 nl3
nl4 nl5 mtxt mlen omlen
MOVE SQLCODE TO SQL-COD
DISPLAY "SQLCODE should be >= 0; its value is ", SQL-COD
if (SQLCODE < 0) then
MOVE 0 TO flag
END-IF
DISPLAY "SQLSTATE should be 00000 or 01004; its value is ",
SQLSTATE
PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
if (NORMSQ NOT = "00000" AND NORMSQ NOT =
"01004") then
MOVE 0 TO flag
END-IF
if (NORMSQ = "00000" AND NORMSQ NOT = SQLSTATE)
then
DISPLAY "Valid implementation-defined SQLSTATE accepted."
END-IF
DISPLAY "int1 should be 2; its value is ", int1
if (int1 NOT = 2) then
MOVE 0 TO flag
END-IF
DISPLAY "co is ", co
DISPLAY "sco is ", sco
if (co NOT = "ISO 9075 " OR sco NOT = "ISO 9075
- " ") then
DISPLAY "Skipping remainder because of imp-defined
- " SQLSTATE"
GO TO P183
END-IF
DISPLAY "st should be 01004; its value is ", st
if (st NOT = "01004") then
MOVE 0 TO flag
END-IF
DISPLAY "nl1 should be ' '; its value is '", nl1 "'"
if (nl1 NOT = " ") then
MOVE 0 TO flag
END-IF
DISPLAY "nl2 should be ' '; its value is '", nl2 "'"
if (nl2 NOT = " ") then
MOVE 0 TO flag
END-IF
DISPLAY "nl3 should be ' '; its value is '", nl3 "'"
if (nl3 NOT = " ") then
MOVE 0 TO flag
END-IF
DISPLAY "nl4 should be ' '; its value is '", nl4 "'"
if (nl4 NOT = " ") then
MOVE 0 TO flag
END-IF
DISPLAY "nl5 should be ' '; its value is '", nl5 "'"
if (nl5 NOT = " ") then
MOVE 0 TO flag
END-IF
DISPLAY "mtxt should be meaningful or blank; its value is
- " '", mtxt "'"
if (mtxt =
"xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") then
MOVE 0 TO flag
END-IF
DISPLAY "mlen should be >= 0; its value is ", mlen
DISPLAY "omlen should be >= 0; its value is ", omlen
if (mlen < 0 OR omlen < 0) then
MOVE 0 TO flag
END-IF
.
P183.
DISPLAY "ROLLBACK WORK;"
* EXEC SQL ROLLBACK WORK;
CALL "SUB71" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
*Check sytax: <number of conditions> as a literal
DISPLAY "SET TRANSACTION DIAGNOSTICS SIZE 2;"
* EXEC SQL SET TRANSACTION DIAGNOSTICS SIZE 2;
CALL "SUB72" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "ROLLBACK WORK;"
* EXEC SQL ROLLBACK WORK;
CALL "SUB73" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "DROP TABLE DOUBLE_TROUBLE CASCADE;"
* EXEC SQL DROP TABLE DOUBLE_TROUBLE CASCADE;
CALL "SUB74" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "COMMIT WORK;"
* EXEC SQL COMMIT WORK;
CALL "SUB75" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
if ( flag = 1 ) then
DISPLAY " *** pass *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0672','pass','MCO');
CALL "SUB76" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " dml152.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0672','fail','MCO');
CALL "SUB77" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB78" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
******************** END TEST0672 ********************
******************** BEGIN TEST0673 *******************
MOVE 1 TO flag
DISPLAY " TEST0673 "
DISPLAY " Diagnostics SQLSTATE: inv. cond. number"
DISPLAY "References:"
DISPLAY " F# 12 -- Get diagnostics"
DISPLAY " 18.1 GR.2"
DISPLAY " - - - - - - - - - - - - - - - - - - -"
COMPUTE SQLCODE = -1
MOVE "xxxxx" TO SQLSTATE
DISPLAY "GET DIAGNOSTICS EXCEPTION 0"
DISPLAY " :int2 = CONDITION_NUMBER;"
* EXEC SQL GET DIAGNOSTICS EXCEPTION 0
* :int2 = CONDITION_NUMBER;
CALL "SUB79" USING SQLCODE SQLSTATE int2
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 35000; its value is ", SQLSTATE
if (SQLCODE NOT < 0 OR NORMSQ NOT = "35000") then
MOVE 0 TO flag
END-IF
if (NORMSQ = "35000" AND NORMSQ NOT = SQLSTATE)
then
DISPLAY "Valid implementation-defined SQLSTATE accepted."
END-IF
DISPLAY " "
COMPUTE int1 = -1
DISPLAY "int1 = -1"
DISPLAY "GET DIAGNOSTICS EXCEPTION :int1"
DISPLAY " :int2 = CONDITION_NUMBER;"
* EXEC SQL GET DIAGNOSTICS EXCEPTION :int1
* :int2 = CONDITION_NUMBER;
CALL "SUB80" USING SQLCODE SQLSTATE int1 int2
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 35000; its value is ", SQLSTATE
if (SQLCODE NOT < 0 OR NORMSQ NOT = "35000") then
MOVE 0 TO flag
END-IF
if (NORMSQ = "35000" AND NORMSQ NOT = SQLSTATE)
then
DISPLAY "Valid implementation-defined SQLSTATE accepted."
END-IF
DISPLAY " "
DISPLAY "ROLLBACK WORK;"
* EXEC SQL ROLLBACK WORK;
CALL "SUB81" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
if ( flag = 1 ) then
DISPLAY " *** pass *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0673','pass','MCO');
CALL "SUB82" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " dml152.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0673','fail','MCO');
CALL "SUB83" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB84" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
******************** END TEST0673 ********************
**** 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.108 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.
|
