* Standard COBOL (file "DML113.SCO") calling SQL * procedures in file "DML113.MCO".
**************************************************************** * * COMMENT SECTION * * DATE 1993/11/10 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. * * DML113.SCO * WRITTEN BY: David W. Flater * TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE * * This routine tests NULLs with DATETIME data types and in * outer joins, datetimes in a <default clause>, TRIM, and also * some schema manipulation statements. * This is the dynamic version of DML112.PC. * * REFERENCES * FIPS PUB 127-2 14.1 Transitional SQL * ANSI SQL-1992 * ****************************************************************
COMPUTE int1 = -1 DISPLAY"FETCH C11313 INTO :int1;" * EXEC SQL FETCH C11313 INTO :int1; CALL"SUB62"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 1; its value is ", int1 if (int1 NOT = 1) then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C11314 INTO :int1;" * EXEC SQL FETCH C11314 INTO :int1; CALL"SUB69"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 0; its value is ", int1 if (int1 NOT = 0) then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C11315 INTO :int1;" * EXEC SQL FETCH C11315 INTO :int1; CALL"SUB73"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 2; its value is ", int1 if (int1 NOT = 2) then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C11316 INTO :int1;" * EXEC SQL FETCH C11316 INTO :int1; CALL"SUB80"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 1; its value is ", int1 if (int1 NOT = 1) then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 MOVE 2 TO ind1 DISPLAY"FETCH C11317 INTO :int1:ind1;" * EXEC SQL FETCH C11317 INTO :int1:ind1; CALL"SUB87"USINGSQLCODE SQLSTATE int1 ind1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"ind1 should be -1; its value is ", ind1 if (ind1 NOT = -1) then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C11318 INTO :int1;" * EXEC SQL FETCH C11318 INTO :int1; CALL"SUB91"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 2; its value is ", int1 if (int1 NOT = 2) then MOVE 0 TO flag END-IF
*Cursor left open.
* EXEC SQL DELETE FROM CONCATBUF; CALL"SUB92"USINGSQLCODE SQLSTATE MOVESQLCODETO SQL-COD * EXEC SQL INSERT INTO CONCATBUF VALUES ( * 'SELECT EXTRACT (HOUR FROM AVG (DWAIT))' || * ' FROM MERCH, TURNAROUND WHERE' || * ' MERCH.ITEMKEY = TURNAROUND.ITEMKEY OR' || * ' TURNAROUND.ITEMKEY NOT IN' || * ' (SELECT ITEMKEY FROM MERCH)' * ); CALL"SUB93"USINGSQLCODE SQLSTATE MOVESQLCODETO SQL-COD * EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF; CALL"SUB94"USINGSQLCODE SQLSTATE longst MOVESQLCODETO SQL-COD
DISPLAY"longst=""", longst """"
DISPLAY"PREPARE S11319 FROM :longst;" * EXEC SQL PREPARE S11319 FROM :longst; CALL"SUB95"USINGSQLCODE SQLSTATE longst MOVESQLCODETO SQL-COD
PERFORM CHCKOK DISPLAY" "
DISPLAY"DECLARE C11319 CURSOR FOR S11319;" * EXEC SQL DECLARE C11319 CURSOR FOR S11319 END-EXEC DISPLAY" "
DISPLAY"SQLCODE should be >= 0; its value is ", SQL-COD if (SQLCODE < 0) then MOVE 0 TO flag END-IF DISPLAY"SQLSTATE can be 00000 or 01003; its value is ",
SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (NORMSQ NOT = "00000"AND SQLSTATE NOT = "01003") then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C11319 INTO :int1;" * EXEC SQL FETCH C11319 INTO :int1; CALL"SUB97"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD
*DML083 set the precedent for requiring 01003 on the fetches. *One might argue that it ought to be returned just on the *open and never again. DML083 is under dispute, so status *codes are checked loosely here.
DISPLAY"SQLCODE should be >= 0; its value is ", SQL-COD if (SQLCODE < 0) then MOVE 0 TO flag END-IF DISPLAY"SQLSTATE can be 00000 or 01003; its value is ",
SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (NORMSQ NOT = "00000"AND SQLSTATE NOT = "01003") then MOVE 0 TO flag END-IF DISPLAY"int1 should be 0; its value is ", int1 if (int1 NOT = 0) then MOVE 0 TO flag END-IF
* EXEC SQL DELETE FROM CONCATBUF; CALL"SUB98"USINGSQLCODE SQLSTATE MOVESQLCODETO SQL-COD * EXEC SQL INSERT INTO CONCATBUF VALUES ( * 'SELECT COUNT(*)' || * ' FROM INVENTORY WHERE MWAIT IS NULL' || * ' AND DWAIT IS NULL' * ); CALL"SUB99"USINGSQLCODE SQLSTATE MOVESQLCODETO SQL-COD * EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF; CALL"SUB100"USINGSQLCODE SQLSTATE longst MOVESQLCODETO SQL-COD
DISPLAY"longst=""", longst """"
DISPLAY"PREPARE S1131A FROM :longst;" * EXEC SQL PREPARE S1131A FROM :longst; CALL"SUB101"USINGSQLCODE SQLSTATE longst MOVESQLCODETO SQL-COD
PERFORM CHCKOK DISPLAY" "
DISPLAY"DECLARE C1131A CURSOR FOR S1131A;" * EXEC SQL DECLARE C1131A CURSOR FOR S1131A END-EXEC DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C1131A INTO :int1;" * EXEC SQL FETCH C1131A INTO :int1; CALL"SUB103"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 2; its value is ", int1 if (int1 NOT = 2) then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C11321 INTO :int1;" * EXEC SQL FETCH C11321 INTO :int1; CALL"SUB147"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 5; its value is ", int1 if (int1 NOT = 5) then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C11322 INTO :int1;" * EXEC SQL FETCH C11322 INTO :int1; CALL"SUB154"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 0; its value is ", int1 if (int1 NOT = 0) then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C11323 INTO :int1;" * EXEC SQL FETCH C11323 INTO :int1; CALL"SUB161"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 0; its value is ", int1 if (int1 NOT = 0) then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C11324 INTO :int1;" * EXEC SQL FETCH C11324 INTO :int1; CALL"SUB168"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 3; its value is ", int1 if (int1 NOT = 3) then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C11321 INTO :int1;" * EXEC SQL FETCH C11321 INTO :int1; CALL"SUB173"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 9; its value is ", int1 if (int1 NOT = 9) then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C11325 INTO :int1;" * EXEC SQL FETCH C11325 INTO :int1; CALL"SUB177"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 4; its value is ", int1 if (int1 NOT = 4) then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C11326 INTO :int1;" * EXEC SQL FETCH C11326 INTO :int1; CALL"SUB181"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 5; its value is ", int1 if (int1 NOT = 5) then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C11327 INTO :int1;" * EXEC SQL FETCH C11327 INTO :int1; CALL"SUB185"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 3; its value is ", int1 if (int1 NOT = 3) then MOVE 0 TO flag END-IF
DISPLAY"dstmt=""SELECT AVG(D1) * 10 FROM JNULL3""" MOVE"SELECT AVG(D1) * 10 FROM JNULL3
- " "TO dstmt
DISPLAY"PREPARE S11328 FROM :dstmt;" * EXEC SQL PREPARE S11328 FROM :dstmt; CALL"SUB187"USINGSQLCODE SQLSTATE dstmt MOVESQLCODETO SQL-COD
PERFORM CHCKOK DISPLAY" "
DISPLAY"DECLARE C11328 CURSOR FOR S11328;" * EXEC SQL DECLARE C11328 CURSOR FOR S11328 END-EXEC DISPLAY" "
DISPLAY"OPEN C11328;" * EXEC SQL OPEN C11328; CALL"SUB188"USINGSQLCODE SQLSTATE MOVESQLCODETO SQL-COD DISPLAY"SQLCODE should be >= 0; its value is ", SQL-COD if (SQLCODE < 0) then MOVE 0 TO flag END-IF DISPLAY"SQLSTATE can be 00000 or 01003; its value is ",
SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (NORMSQ NOT = "00000"AND SQLSTATE NOT = "01003") then MOVE 0 TO flag END-IF DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C11328 INTO :int1;" * EXEC SQL FETCH C11328 INTO :int1; CALL"SUB189"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD DISPLAY"SQLCODE should be >= 0; its value is ", SQL-COD if (SQLCODE < 0) then MOVE 0 TO flag END-IF DISPLAY"SQLSTATE can be 00000 or 01003; its value is ",
SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (NORMSQ NOT = "00000"AND SQLSTATE NOT = "01003") then MOVE 0 TO flag END-IF DISPLAY"int1 should be 15; its value is ", int1 if (int1 NOT = 15) then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C11329 INTO :int1;" * EXEC SQL FETCH C11329 INTO :int1; CALL"SUB196"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 6; its value is ", int1 if (int1 NOT = 6) then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C1132A INTO :int1;" * EXEC SQL FETCH C1132A INTO :int1; CALL"SUB203"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 2; its value is ", int1 if (int1 NOT = 2) then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C1132B INTO :int1;" * EXEC SQL FETCH C1132B INTO :int1; CALL"SUB210"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 2; its value is ", int1 if (int1 NOT = 2) then MOVE 0 TO flag END-IF
DISPLAY"dstmt=""SELECT COUNT(*) FROM CHANGG WHERE DIVORCES
- " IS NULL""" MOVE"SELECT COUNT(*) FROM CHANGG WHERE DIVORCES
- " IS NULL"TO dstmt
DISPLAY"PREPARE S11331 FROM :dstmt;" * EXEC SQL PREPARE S11331 FROM :dstmt; CALL"SUB230"USINGSQLCODE SQLSTATE dstmt MOVESQLCODETO SQL-COD
if (SQLCODE = 0) then DISPLAY"SQLCODE is 0" GOTO P101 END-IF
DISPLAY"SQLCODE is ", SQL-COD 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 GOTO P100
.
P101. DISPLAY"DECLARE C11331 CURSOR FOR S11331;" * EXEC SQL DECLARE C11331 CURSOR FOR S11331 END-EXEC DISPLAY" "
if (SQLCODE = 0) then DISPLAY"SQLCODE is 0" GOTO P102 END-IF
DISPLAY"SQLCODE is ", SQL-COD 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 GOTO P100
.
P102. DISPLAY"FETCH C11331 INTO :int1;" * EXEC SQL FETCH C11331 INTO :int1; CALL"SUB232"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD DISPLAY"SQLCODE should be < 0; its value is ", SQL-COD DISPLAY"SQLSTATE should be '42000'; its value is '",
SQLSTATE "'" if (SQLCODENOT < 0) then MOVE 0 TO flag END-IF 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
COMPUTE int1 = -1 DISPLAY"FETCH C11332 INTO :int1;" * EXEC SQL FETCH C11332 INTO :int1; CALL"SUB248"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 0; its value is ", int1 if (int1 NOT = 0) then MOVE 0 TO flag END-IF
* EXEC SQL DELETE FROM CONCATBUF; CALL"SUB267"USINGSQLCODE SQLSTATE MOVESQLCODETO SQL-COD * EXEC SQL INSERT INTO CONCATBUF VALUES ( * 'SELECT AGE, NUMBRR, DIVORCES FROM CHANGG' || * ' WHERE NAAM = ?' * ); CALL"SUB268"USINGSQLCODE SQLSTATE MOVESQLCODETO SQL-COD * EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF; CALL"SUB269"USINGSQLCODE SQLSTATE longst MOVESQLCODETO SQL-COD
DISPLAY"longst=""", longst """"
DISPLAY"PREPARE S11333 FROM :longst;" * EXEC SQL PREPARE S11333 FROM :longst; CALL"SUB270"USINGSQLCODE SQLSTATE longst MOVESQLCODETO SQL-COD
PERFORM CHCKOK DISPLAY" "
DISPLAY"DECLARE C11333 CURSOR FOR S11333;" * EXEC SQL DECLARE C11333 CURSOR FOR S11333 END-EXEC DISPLAY" "
MOVE"RUDOLPH "TO ch3 DISPLAY"ch3 is '", CH3 "'"
DISPLAY"OPEN C11333 USING :ch3;" * EXEC SQL OPEN C11333 USING :ch3; CALL"SUB271"USINGSQLCODE SQLSTATE ch3 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 COMPUTE int2 = -1 MOVE"xxxxxxxxxxx"TO ch1 DISPLAY"FETCH C11333 INTO :int1, :ch1, :int2;" * EXEC SQL FETCH C11333 INTO :int1, :ch1, :int2; CALL"SUB272"USINGSQLCODE SQLSTATE int1 ch1 int2 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 54; its value is ", int1 DISPLAY"int2 should be 3; its value is ", int2 DISPLAY"ch1 should be '837-47-1847'; its value is '",
ch1 "'" if (int1 NOT = 54 OR int2 NOT = 3) then MOVE 0 TO flag END-IF if (ch1 NOT = "837-47-1847") then MOVE 0 TO flag END-IF
DISPLAY"OPEN C11333 USING :ch3;" * EXEC SQL OPEN C11333 USING :ch3; CALL"SUB274"USINGSQLCODE SQLSTATE ch3 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 COMPUTE int2 = -1 MOVE 10 TO ind1 MOVE"xxxxxxxxxxx"TO ch1 DISPLAY"FETCH C11333 INTO :int1, :ch1, :int2:ind1;" * EXEC SQL FETCH C11333 INTO :int1, :ch1, :int2:ind1; CALL"SUB275"USINGSQLCODE SQLSTATE int1 ch1 int2 ind1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 33; its value is ", int1 DISPLAY"ind1 should be -1; its value is ", ind1 DISPLAY"ch1 should be '738-47-1847'; its value is '",
ch1 "'" if (int1 NOT = 33 OR ind1 NOT = -1) then MOVE 0 TO flag END-IF if (ch1 NOT = "738-47-1847") then MOVE 0 TO flag END-IF
DISPLAY"OPEN C11333 USING :ch3;" * EXEC SQL OPEN C11333 USING :ch3; CALL"SUB277"USINGSQLCODE SQLSTATE ch3 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 COMPUTE int2 = -1 MOVE"xxxxxxxxxxx"TO ch1 DISPLAY"FETCH C11333 INTO :int1, :ch1, :int2;" * EXEC SQL FETCH C11333 INTO :int1, :ch1, :int2; CALL"SUB278"USINGSQLCODE SQLSTATE int1 ch1 int2 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 16; its value is ", int1 DISPLAY"int2 should be 0; its value is ", int2 DISPLAY"ch1 should be '000-10-0001'; its value is '",
ch1 "'" if (int1 NOT = 16 OR int2 NOT = 0) then MOVE 0 TO flag END-IF if (ch1 NOT = "000-10-0001") then MOVE 0 TO flag END-IF
DISPLAY"OPEN C11333 USING :ch3;" * EXEC SQL OPEN C11333 USING :ch3; CALL"SUB280"USINGSQLCODE SQLSTATE ch3 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 COMPUTE int2 = -1 MOVE"xxxxxxxxxxx"TO ch1 DISPLAY"FETCH C11333 INTO :int1, :ch1, :int2;" * EXEC SQL FETCH C11333 INTO :int1, :ch1, :int2; CALL"SUB281"USINGSQLCODE SQLSTATE int1 ch1 int2 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 20; its value is ", int1 DISPLAY"int2 should be 0; its value is ", int2 DISPLAY"ch1 should be '111-11-1111'; its value is '",
ch1 "'" if (int1 NOT = 20 OR int2 NOT = 0) then MOVE 0 TO flag END-IF if (ch1 NOT = "111-11-1111") then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C11334 INTO :int1;" * EXEC SQL FETCH C11334 INTO :int1; CALL"SUB285"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 4; its value is ", int1 if (int1 NOT = 4) then MOVE 0 TO flag END-IF
DISPLAY"dstmt=""SELECT COUNT(*) FROM CHANGG WHERE AGE >
- " 30""" MOVE"SELECT COUNT(*) FROM CHANGG WHERE AGE > 30
- " "TO dstmt
DISPLAY"PREPARE S11335 FROM :dstmt;" * EXEC SQL PREPARE S11335 FROM :dstmt; CALL"SUB292"USINGSQLCODE SQLSTATE dstmt MOVESQLCODETO SQL-COD
if (SQLCODE = 0) then DISPLAY"SQLCODE is 0" GOTO P104 END-IF
DISPLAY"SQLCODE is ", SQL-COD 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 GOTO P103
.
P104. DISPLAY"DECLARE C11335 CURSOR FOR S11335;" * EXEC SQL DECLARE C11335 CURSOR FOR S11335 END-EXEC DISPLAY" "
if (SQLCODE = 0) then DISPLAY"SQLCODE is 0" GOTO P105 END-IF
DISPLAY"SQLCODE is ", SQL-COD 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 GOTO P103
.
P105. DISPLAY"FETCH C11335 INTO :int1;" * EXEC SQL FETCH C11335 INTO :int1; CALL"SUB294"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD DISPLAY"SQLCODE should be < 0; its value is ", SQL-COD DISPLAY"SQLSTATE should be '42000'; its value is '",
SQLSTATE "'" if (SQLCODENOT < 0) then MOVE 0 TO flag END-IF 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"dstmt=""SELECT COUNT(*) FROM CHANGG WHERE DIVORCES
- " IS NULL""" MOVE"SELECT COUNT(*) FROM CHANGG WHERE DIVORCES
- " IS NULL"TO dstmt
DISPLAY"PREPARE S11336 FROM :dstmt;" * EXEC SQL PREPARE S11336 FROM :dstmt; CALL"SUB296"USINGSQLCODE SQLSTATE dstmt MOVESQLCODETO SQL-COD
if (SQLCODE = 0) then DISPLAY"SQLCODE is 0" GOTO P107 END-IF
DISPLAY"SQLCODE is ", SQL-COD 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 GOTO P106
.
P107. DISPLAY"DECLARE C11336 CURSOR FOR S11336;" * EXEC SQL DECLARE C11336 CURSOR FOR S11336 END-EXEC DISPLAY" "
if (SQLCODE = 0) then DISPLAY"SQLCODE is 0" GOTO P108 END-IF
DISPLAY"SQLCODE is ", SQL-COD 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 GOTO P106
.
P108. DISPLAY"FETCH C11336 INTO :int1;" * EXEC SQL FETCH C11336 INTO :int1; CALL"SUB298"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD DISPLAY"SQLCODE should be < 0; its value is ", SQL-COD DISPLAY"SQLSTATE should be '42000'; its value is '",
SQLSTATE "'" if (SQLCODENOT < 0) then MOVE 0 TO flag END-IF 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
COMPUTE int1 = -1 DISPLAY"FETCH C11337 INTO :ch2;" * EXEC SQL FETCH C11337 INTO :ch2; CALL"SUB302"USINGSQLCODE SQLSTATE ch2 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"ch2 should be 'GOOBER '; its value is '",
ch2 "'" if (ch2 NOT = "GOOBER ") then MOVE 0 TO flag END-IF
*TEd Hook #1 Check 11.15 SR.3 (can't drop all the columns) DISPLAY"dstmt=""ALTER TABLE CHANGG DROP NUMBRR RESTRICT""" MOVE"ALTER TABLE CHANGG DROP NUMBRR RESTRICT " TO dstmt
DISPLAY"EXECUTE IMMEDIATE :dstmt;" * EXEC SQL EXECUTE IMMEDIATE :dstmt; CALL"SUB307"USINGSQLCODE SQLSTATE dstmt MOVESQLCODETO SQL-COD DISPLAY"SQLCODE should be < 0; its value is ", SQL-COD if (SQLCODENOT < 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
COMPUTE int1 = -1 DISPLAY"FETCH C11342 INTO :int1;" * EXEC SQL FETCH C11342 INTO :int1; CALL"SUB340"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 0; its value is ", int1 if (int1 NOT = 0) then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C11343 INTO :int1;" * EXEC SQL FETCH C11343 INTO :int1; CALL"SUB344"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 4; its value is ", int1 if (int1 NOT = 4) then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C11344 INTO :int1;" * EXEC SQL FETCH C11344 INTO :int1; CALL"SUB351"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 0; its value is ", int1 if (int1 NOT = 0) then MOVE 0 TO flag END-IF
* EXEC SQL DELETE FROM CONCATBUF; CALL"SUB353"USINGSQLCODE SQLSTATE MOVESQLCODETO SQL-COD * EXEC SQL INSERT INTO CONCATBUF VALUES ( * 'SELECT COUNT (*) FROM OBITUARIES' || * ' WHERE BORN <> DATE ''1880-01-01''' || * ' OR BORN IS NULL' || * ' OR DIED <> TESTING1' || * ' OR DIED IS NULL' || * ' OR ENTERED <> TESTING2' || * ' OR ENTERED IS NULL' * ); CALL"SUB354"USINGSQLCODE SQLSTATE MOVESQLCODETO SQL-COD * EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF; CALL"SUB355"USINGSQLCODE SQLSTATE longst MOVESQLCODETO SQL-COD
DISPLAY"longst=""", longst """"
DISPLAY"PREPARE S11345 FROM :longst;" * EXEC SQL PREPARE S11345 FROM :longst; CALL"SUB356"USINGSQLCODE SQLSTATE longst MOVESQLCODETO SQL-COD
PERFORM CHCKOK DISPLAY" "
DISPLAY"DECLARE C11345 CURSOR FOR S11345;" * EXEC SQL DECLARE C11345 CURSOR FOR S11345 END-EXEC DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C11345 INTO :int1;" * EXEC SQL FETCH C11345 INTO :int1; CALL"SUB358"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 0; its value is ", int1 if (int1 NOT = 0) then MOVE 0 TO flag END-IF
MOVE"BLAHBLAHBLAHBL"TO ch2 DISPLAY"FETCH C11351 INTO :ch2;" * EXEC SQL FETCH C11351 INTO :ch2; CALL"SUB387"USINGSQLCODE SQLSTATE ch2 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"ch2 should be 'KATE'; its value is '", ch2 "'"
*In languages with variable length strings, the result should *not have trailing blanks. * if (ch2 NOT = "KATE")
MOVE"BLAHBLAHBLAHBL"TO ch2 DISPLAY"FETCH C11352 INTO :ch2;" * EXEC SQL FETCH C11352 INTO :ch2; CALL"SUB394"USINGSQLCODE SQLSTATE ch2 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"ch2 should be 'KATEXXXXXX'; its value is '",
ch2 "'"
*In languages with variable length strings, the result should *not have trailing blanks. * if (ch2 NOT = "KATEXXXXXX")
if (ch2 NOT = "KATEXXXXXX") then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C11353 INTO :int1;" * EXEC SQL FETCH C11353 INTO :int1; CALL"SUB401"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 1; its value is ", int1 if (int1 NOT = 1) then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C11354 INTO :int1;" * EXEC SQL FETCH C11354 INTO :int1; CALL"SUB408"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 1; its value is ", int1 if (int1 NOT = 1) then MOVE 0 TO flag END-IF
* EXEC SQL DELETE FROM CONCATBUF; CALL"SUB410"USINGSQLCODE SQLSTATE MOVESQLCODETO SQL-COD * EXEC SQL INSERT INTO CONCATBUF VALUES ( * 'SELECT TRIM (''BB'' FROM NAAM)' || * ' FROM WEIRDPAD WHERE NAAM LIKE' || * ' ''KATE%''' * ); CALL"SUB411"USINGSQLCODE SQLSTATE MOVESQLCODETO SQL-COD * EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF; CALL"SUB412"USINGSQLCODE SQLSTATE longst MOVESQLCODETO SQL-COD
DISPLAY"longst=""", longst """"
DISPLAY"PREPARE S11355 FROM :longst;" * EXEC SQL PREPARE S11355 FROM :longst; CALL"SUB413"USINGSQLCODE SQLSTATE longst MOVESQLCODETO SQL-COD
if (SQLCODE = 0) then DISPLAY"SQLCODE is 0" GOTO P111 END-IF
DISPLAY"SQLCODE should be < 0; its value is ", SQL-COD DISPLAY"SQLSTATE should be 22027; its value is ", SQLSTATE if (SQLCODENOT < 0 OR SQLSTATE NOT = "22027") then MOVE 0 TO flag END-IF GOTO P110
.
P111. DISPLAY"DECLARE C11355 CURSOR FOR S11355;" * EXEC SQL DECLARE C11355 CURSOR FOR S11355 END-EXEC DISPLAY" "
if (SQLCODE = 0) then DISPLAY"SQLCODE is 0" GOTO P109 END-IF
DISPLAY"SQLCODE should be < 0; its value is ", SQL-COD DISPLAY"SQLSTATE should be 22027; its value is ", SQLSTATE if (SQLCODENOT < 0 OR SQLSTATE NOT = "22027") then MOVE 0 TO flag END-IF GOTO P110
.
P109. DISPLAY"FETCH C11355 INTO :int1;" * EXEC SQL FETCH C11355 INTO :int1; CALL"SUB415"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD DISPLAY"SQLCODE should be < 0; its value is ", SQL-COD DISPLAY"SQLSTATE should be 22027; its value is ", SQLSTATE if (SQLCODENOT < 0 OR SQLSTATE NOT = "22027") then MOVE 0 TO flag END-IF
* EXEC SQL COMMIT WORK; CALL"SUB422"USINGSQLCODE SQLSTATE MOVESQLCODETO SQL-COD ******************** END TEST0634 ******************** **** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0 STOPRUN.
* **** 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 (SQLCODENOT = 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 PERFORMVARYING 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 GOTO EXIT-NOSUBCLASS END-IF
MOVE 4 TO norm1 *examining position 4 of char array NORMSQ *valid characters are 0-9, A-Z PERFORMVARYING 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 PERFORMVARYING 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.
Messung V0.5 in Prozent
¤ 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.0.140Bemerkung:
(vorverarbeitet am 2026-04-28)
¤
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 und die Messung sind noch experimentell.