* Standard COBOL (file "CDR029.SCO") calling SQL * procedures in file "CDR029.MCO". * STANDARD COBOL (file "CDR029.SCO")
**************************************************************** * * COMMENT SECTION * * DATE 1992/08/06 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. * * CDR029.SCO * WRITTEN BY: DAVID W. FLATER * * THIS ROUTINE TESTS FOR IMPLICIT JOINS AND FOR PROBLEMS * WITH CONSTRAINTS WHICH COMPARE ONE COLUMN VALUE AGAINST * ANOTHER. * ****************************************************************
COMPUTE count1 = -1 DISPLAY" " DISPLAY"SELECT COUNT(*) INTO :count1" DISPLAY" FROM CPBASE, CPREF;"
* EXEC SQL SELECT COUNT(*) INTO :count1 * FROM CPBASE, CPREF; CALL"SUB8"USINGSQLCODE SQLSTATE count1 MOVESQLCODETO SQL-COD
DISPLAY"SQLCODE should be 0; its value is ", SQL-COD DISPLAY"count1 should be 4; its value is ", count1 DISPLAY"A value of 2 would indicate that a natural join
- " was done."
if (SQLCODENOT = 0OR count1 NOT = 4) then MOVE0TO flag END-IF
COMPUTE count1 = -1 DISPLAY" " DISPLAY"DECLARE KURSOR CURSOR FOR SELECT KC, JUNK2" DISPLAY" FROM CPBASE, CPREF ORDER BY JUNK2, KC;" DISPLAY"OPEN KURSOR;" DISPLAY"FETCH KURSOR INTO :CPNUM1, :junkit; SEVEN TIMES"
* EXEC SQL DECLARE KURSOR CURSOR FOR SELECT KC, JUNK2 * FROM CPBASE, CPREF ORDER BY JUNK2, KC END-EXEC * EXEC SQL OPEN KURSOR; CALL"SUB9"USINGSQLCODE SQLSTATE MOVESQLCODETO SQL-COD MOVE1TO ii PERFORM P50 UNTIL ii > 7
DISPLAY"count1 should be 4; its value is ", count1 DISPLAY"A value of 2 would indicate that a natural join
- " was done."
* * SPECIAL NOTE * * Do not try to shorten the test by using rollbacks instead * of insert, commit, delete, commit. These constraints * can be deferred until commit time.
COMPUTE count1 = -1 DISPLAY"SELECT COUNT(*) INTO :count1 FROM RET_CATALOG;" * EXEC SQL SELECT COUNT(*) INTO :count1 FROM RET_CATALOG * ; CALL"SUB18"USINGSQLCODE SQLSTATE count1 MOVESQLCODETO SQL-COD
DISPLAY"SQLCODE should be 0; its value is ", SQL-COD DISPLAY"count1 should be 1; its value is ", count1 if (SQLCODENOT = 0OR count1 NOT = 1) then MOVE0TO flag END-IF
COMPUTE count1 = -1 DISPLAY"SELECT COUNT(*) INTO :count1 FROM RET_CATALOG;" * EXEC SQL SELECT COUNT(*) INTO :count1 FROM RET_CATALOG * ; CALL"SUB31"USINGSQLCODE SQLSTATE count1 MOVESQLCODETO SQL-COD
DISPLAY"SQLCODE should be 0; its value is ", SQL-COD DISPLAY"count1 should be 4; its value is ", count1 if (SQLCODENOT = 0OR count1 NOT = 4) then MOVE0TO flag END-IF
COMPUTE count1 = -1 DISPLAY"SELECT COUNT(*) INTO :count1 FROM RET_CATALOG" DISPLAY"WHERE PRODUCT_ID = 0;" * EXEC SQL SELECT COUNT(*) INTO :count1 FROM RET_CATALOG * WHERE PRODUCT_ID = 0; CALL"SUB32"USINGSQLCODE SQLSTATE count1 MOVESQLCODETO SQL-COD
DISPLAY"SQLCODE should be 0; its value is ", SQL-COD DISPLAY"count1 should be 0; its value is ", count1 if (SQLCODENOT = 0OR count1 NOT = 0) then MOVE0TO flag END-IF
COMPUTE count1 = -1 DISPLAY"SELECT COUNT(*) INTO :count1 FROM RET_CATALOG;" * EXEC SQL SELECT COUNT(*) INTO :count1 FROM RET_CATALOG * ; CALL"SUB45"USINGSQLCODE SQLSTATE count1 MOVESQLCODETO SQL-COD
DISPLAY"SQLCODE should be 0; its value is ", SQL-COD DISPLAY"count1 should be 4; its value is ", count1 if (SQLCODENOT = 0OR count1 NOT = 4) then MOVE0TO flag END-IF
COMPUTE count1 = -1 DISPLAY"SELECT COUNT(*) INTO :count1 FROM RET_CATALOG" DISPLAY"WHERE PRODUCT_ID = 0;" * EXEC SQL SELECT COUNT(*) INTO :count1 FROM RET_CATALOG * WHERE PRODUCT_ID = 0; CALL"SUB46"USINGSQLCODE SQLSTATE count1 MOVESQLCODETO SQL-COD
DISPLAY"SQLCODE should be 0; its value is ", SQL-COD DISPLAY"count1 should be 0; its value is ", count1 if (SQLCODENOT = 0OR count1 NOT = 0) then MOVE0TO flag END-IF
COMPUTE count1 = -1 DISPLAY"SELECT COUNT(*) INTO :count1 FROM RET_CATALOG;" * EXEC SQL SELECT COUNT(*) INTO :count1 FROM RET_CATALOG * ; CALL"SUB59"USINGSQLCODE SQLSTATE count1 MOVESQLCODETO SQL-COD
DISPLAY"SQLCODE should be 0; its value is ", SQL-COD DISPLAY"count1 should be 4; its value is ", count1 if (SQLCODENOT = 0OR count1 NOT = 4) then MOVE0TO flag END-IF
COMPUTE count1 = -1 DISPLAY"SELECT COUNT(*) INTO :count1 FROM RET_CATALOG" DISPLAY"WHERE PRODUCT_ID = 0;" * EXEC SQL SELECT COUNT(*) INTO :count1 FROM RET_CATALOG * WHERE PRODUCT_ID = 0; CALL"SUB60"USINGSQLCODE SQLSTATE count1 MOVESQLCODETO SQL-COD
DISPLAY"SQLCODE should be 0; its value is ", SQL-COD DISPLAY"count1 should be 0; its value is ", count1 if (SQLCODENOT = 0OR count1 NOT = 0) then MOVE0TO flag END-IF
COMPUTE count1 = -1 DISPLAY"SELECT COUNT(*) INTO :count1 FROM RET_CATALOG;" * EXEC SQL SELECT COUNT(*) INTO :count1 FROM RET_CATALOG * ; CALL"SUB81"USINGSQLCODE SQLSTATE count1 MOVESQLCODETO SQL-COD
DISPLAY"SQLCODE should be 0; its value is ", SQL-COD DISPLAY"count1 should be 8; its value is ", count1 if (SQLCODENOT = 0OR count1 NOT = 8) then MOVE0TO flag END-IF
COMPUTE count1 = -1 DISPLAY"SELECT COUNT(*) INTO :count1 FROM RET_CATALOG" DISPLAY"WHERE PRODUCT_ID = 0;" * EXEC SQL SELECT COUNT(*) INTO :count1 FROM RET_CATALOG * WHERE PRODUCT_ID = 0; CALL"SUB82"USINGSQLCODE SQLSTATE count1 MOVESQLCODETO SQL-COD
DISPLAY"SQLCODE should be 0; its value is ", SQL-COD DISPLAY"count1 should be 0; its value is ", count1 if (SQLCODENOT = 0OR count1 NOT = 0) then MOVE0TO flag END-IF
MOVE"x"TO SQLSTATE * EXEC SQL INSERT INTO SALE_ITEMS VALUES * (0, 0, NULL, 100.00, NULL, 'D1', NULL); CALL"SUB90"USINGSQLCODE SQLSTATE MOVESQLCODETO SQL-COD DISPLAY"SQLCODE should be < 0; its value is ", SQL-COD DISPLAY"SQLSTATE should be 44000; its value is ", SQLSTATE
PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (SQLCODENOT < 0OR NR-TAB NOT = "44000") then MOVE0TO flag END-IF
DISPLAY" " COMPUTE count1 = -1 DISPLAY"SELECT COUNT(*) INTO :count1 FROM RET_CATALOG;" * EXEC SQL SELECT COUNT(*) INTO :count1 FROM RET_CATALOG * ; CALL"SUB91"USINGSQLCODE SQLSTATE count1 MOVESQLCODETO SQL-COD
DISPLAY"SQLCODE should be 0; its value is ", SQL-COD DISPLAY"count1 should be 0; its value is ", count1 if (SQLCODENOT = 0OR count1 NOT = 0) then MOVE0TO flag END-IF
MOVE"x"TO SQLSTATE * EXEC SQL INSERT INTO SALE_ITEMS VALUES * (0, 0, 80.00, 100.00, 20.00, 'D1', NULL); CALL"SUB92"USINGSQLCODE SQLSTATE MOVESQLCODETO SQL-COD DISPLAY"SQLCODE should be < 0; its value is ", SQL-COD DISPLAY"SQLSTATE should be 44000; its value is ", SQLSTATE
PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (SQLCODENOT < 0OR NR-TAB NOT = "44000") then MOVE0TO flag END-IF
DISPLAY" " COMPUTE count1 = -1 DISPLAY"SELECT COUNT(*) INTO :count1 FROM RET_CATALOG;" * EXEC SQL SELECT COUNT(*) INTO :count1 FROM RET_CATALOG * ; CALL"SUB93"USINGSQLCODE SQLSTATE count1 MOVESQLCODETO SQL-COD
DISPLAY"SQLCODE should be 0; its value is ", SQL-COD DISPLAY"count1 should be 0; its value is ", count1 if (SQLCODENOT = 0OR count1 NOT = 0) then MOVE0TO flag END-IF
MOVE"x"TO SQLSTATE * EXEC SQL INSERT INTO SALE_ITEMS VALUES * (0, 0, 99.00, 100.00, 1.00, 'D1', NULL); CALL"SUB94"USINGSQLCODE SQLSTATE MOVESQLCODETO SQL-COD 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 = 0OR NR-TAB NOT = "00000") then MOVE0TO flag END-IF
DISPLAY" " COMPUTE count1 = -1 DISPLAY"SELECT COUNT(*) INTO :count1 FROM RET_CATALOG;" * EXEC SQL SELECT COUNT(*) INTO :count1 FROM RET_CATALOG * ; CALL"SUB95"USINGSQLCODE SQLSTATE count1 MOVESQLCODETO SQL-COD
DISPLAY"SQLCODE should be 0; its value is ", SQL-COD DISPLAY"count1 should be 1; its value is ", count1 if (SQLCODENOT = 0OR count1 NOT = 1) then MOVE0TO flag END-IF
******************** END TEST0538 ******************** **** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0 STOPRUN.
* **** Procedures for PERFORM statements
P50. * EXEC SQL FETCH KURSOR INTO :CPNUM1, :junkit; CALL"SUB101"USINGSQLCODE SQLSTATE CPNUM1 junkit MOVESQLCODETO SQL-COD if (SQLCODE = 0) then MOVE ii TO count1 END-IF ADD1TO ii
.
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 NR-TAB
MOVE3TO norm1 *subclass begins in position 3 of char array NORMSQ MOVE14TO norm2 PERFORM P90 UNTIL norm2 > 36
if (NR-TAB = SQLSTATE) then GOTO EXIT-NOSUBCLASS END-IF *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)
MOVE4TO norm1 *examining position 4 of char array NORMSQ MOVE1TO norm2 PERFORM P89 UNTIL norm2 > 36
MOVE5TO norm1 *examining position 5 of char array NORMSQ MOVE1TO norm2 PERFORM P88 UNTIL norm2 > 36
*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 (NORMSQ(1) = "0"AND NORMSQ(2) = "1") then MOVE"0"TO NORMSQ(2) END-IF GOTO EXIT-NOSUBCLASS
.
P90. *valid subclass begins with 5-9, I-Z, end of ALPNUM table if (NORMSQ(norm1) = ALPNUM(norm2)) then MOVE"0"TO NORMSQ(norm1) END-IF ADD1TO norm2
.
P89. *valid characters are 0-9, A-Z if (NORMSQ(norm1) = ALPNUM(norm2)) then MOVE"0"TO NORMSQ(norm1) END-IF ADD1TO norm2
.
P88. *valid characters are 0-9, A-Z if (NORMSQ(norm1) = ALPNUM(norm2)) then MOVE"0"TO NORMSQ(norm1) END-IF ADD1TO norm2
.
EXIT-NOSUBCLASS. EXIT.
Messung V0.5 in Prozent
¤ Dauer der Verarbeitung: 0.16 Sekunden
(vorverarbeitet am 2026-06-07)
¤
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.