* Standard COBOL (file "DML118.SCO") calling SQL * procedures in file "DML118.MCO".
**************************************************************** * * COMMENT SECTION * * DATE 1994/6/2 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. * * DML118.SCO * WRITTEN BY: David W. Flater * TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE * * This routine tests FIPS feature 19. * This is the dynamic version of DML117.PC. * * REFERENCES * FIPS PUB 127-2 14.1 Transitional SQL * ANSI SQL-1992 * ****************************************************************
*The persistent audit records need to be consistent in the *event that a LUSER_ID is recycled after someone is deleted. *The original LUSER_ID is preserved in SAVED_LUSER_ID in case *it is needed.
DISPLAY"CREATE TABLE AUDIT_RECORDS (" DISPLAY" FOREIGN KEY (LUSER_ID) REFERENCES LUSERS ON
- " DELETE SET NULL," DISPLAY" LUSER_ID INT," DISPLAY" SAVED_LUSER_ID INT NOT NULL" DISPLAY" REFERENCES ALL_USER_IDS (LUSER_ID) ON DELETE
- " NO ACTION," DISPLAY" ACTION_KEY INT DEFAULT 0 NOT NULL" DISPLAY" REFERENCES AUDIT_CODES ON DELETE SET
- " DEFAULT);" * EXEC SQL CREATE TABLE AUDIT_RECORDS ( * FOREIGN KEY (LUSER_ID) REFERENCES LUSERS ON DELETE SET * NULL, * LUSER_ID INT, * SAVED_LUSER_ID INT NOT NULL * REFERENCES ALL_USER_IDS (LUSER_ID) ON DELETE NO ACTION, * ACTION_KEY INT DEFAULT 0 NOT NULL * REFERENCES AUDIT_CODES ON DELETE SET DEFAULT); CALL"SUB23"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
DISPLAY"dstmt=""SELECT COUNT(*) FROM LUSER_DATA""" MOVE"SELECT COUNT(*) FROM LUSER_DATA
- " "TO dstmt
DISPLAY"PREPARE S11811 FROM :dstmt;" * EXEC SQL PREPARE S11811 FROM :dstmt; CALL"SUB54"USING SQLCODE SQLSTATE dstmt MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK DISPLAY" "
DISPLAY"DECLARE C11811 CURSOR FOR S11811;" * EXEC SQL DECLARE C11811 CURSOR FOR S11811 END-EXEC DISPLAY" "
DISPLAY"OPEN C11811;" * EXEC SQL OPEN C11811; CALL"SUB55"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C11811 INTO :int1;" * EXEC SQL FETCH C11811 INTO :int1; CALL"SUB56"USING SQLCODE SQLSTATE int1 MOVE SQLCODE TO 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"CLOSE C11811;" * EXEC SQL CLOSE C11811; CALL"SUB57"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
DISPLAY"dstmt=""SELECT COUNT(*) FROM LUSERS""" MOVE"SELECT COUNT(*) FROM LUSERS
- " "TO dstmt
DISPLAY"PREPARE S11812 FROM :dstmt;" * EXEC SQL PREPARE S11812 FROM :dstmt; CALL"SUB58"USING SQLCODE SQLSTATE dstmt MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK DISPLAY" "
DISPLAY"DECLARE C11812 CURSOR FOR S11812;" * EXEC SQL DECLARE C11812 CURSOR FOR S11812 END-EXEC DISPLAY" "
DISPLAY"OPEN C11812;" * EXEC SQL OPEN C11812; CALL"SUB59"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C11812 INTO :int1;" * EXEC SQL FETCH C11812 INTO :int1; CALL"SUB60"USING SQLCODE SQLSTATE int1 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 1; its value is ", int1 if (int1 NOT = 1) then MOVE 0 TO flag END-IF
DISPLAY"CLOSE C11812;" * EXEC SQL CLOSE C11812; CALL"SUB61"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
DISPLAY"dstmt=""SELECT COUNT(*) FROM AUDIT_RECORDS""" MOVE"SELECT COUNT(*) FROM AUDIT_RECORDS
- " "TO dstmt
DISPLAY"PREPARE S11813 FROM :dstmt;" * EXEC SQL PREPARE S11813 FROM :dstmt; CALL"SUB62"USING SQLCODE SQLSTATE dstmt MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK DISPLAY" "
DISPLAY"DECLARE C11813 CURSOR FOR S11813;" * EXEC SQL DECLARE C11813 CURSOR FOR S11813 END-EXEC DISPLAY" "
DISPLAY"OPEN C11813;" * EXEC SQL OPEN C11813; CALL"SUB63"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C11813 INTO :int1;" * EXEC SQL FETCH C11813 INTO :int1; CALL"SUB64"USING SQLCODE SQLSTATE int1 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 12; its value is ", int1 if (int1 NOT = 12) then MOVE 0 TO flag END-IF
DISPLAY"CLOSE C11813;" * EXEC SQL CLOSE C11813; CALL"SUB65"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
* EXEC SQL DELETE FROM CONCATBUF; CALL"SUB66"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD * EXEC SQL INSERT INTO CONCATBUF VALUES ( * 'SELECT COUNT(*) FROM AUDIT_RECORDS' || * ' WHERE LUSER_ID IS NULL' * ); CALL"SUB67"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD * EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF; CALL"SUB68"USING SQLCODE SQLSTATE longst MOVE SQLCODE TO SQL-COD
DISPLAY"longst=""", longst """"
DISPLAY"PREPARE S11814 FROM :longst;" * EXEC SQL PREPARE S11814 FROM :longst; CALL"SUB69"USING SQLCODE SQLSTATE longst MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK DISPLAY" "
DISPLAY"DECLARE C11814 CURSOR FOR S11814;" * EXEC SQL DECLARE C11814 CURSOR FOR S11814 END-EXEC DISPLAY" "
DISPLAY"OPEN C11814;" * EXEC SQL OPEN C11814; CALL"SUB70"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C11814 INTO :int1;" * EXEC SQL FETCH C11814 INTO :int1; CALL"SUB71"USING SQLCODE SQLSTATE int1 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 10; its value is ", int1 if (int1 NOT = 10) then MOVE 0 TO flag END-IF
DISPLAY"CLOSE C11814;" * EXEC SQL CLOSE C11814; CALL"SUB72"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
* EXEC SQL DELETE FROM CONCATBUF; CALL"SUB73"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD * EXEC SQL INSERT INTO CONCATBUF VALUES ( * 'SELECT COUNT(*) FROM AUDIT_RECORDS' || * ' WHERE SAVED_LUSER_ID IS NULL' * ); CALL"SUB74"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD * EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF; CALL"SUB75"USING SQLCODE SQLSTATE longst MOVE SQLCODE TO SQL-COD
DISPLAY"longst=""", longst """"
DISPLAY"PREPARE S11815 FROM :longst;" * EXEC SQL PREPARE S11815 FROM :longst; CALL"SUB76"USING SQLCODE SQLSTATE longst MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK DISPLAY" "
DISPLAY"DECLARE C11815 CURSOR FOR S11815;" * EXEC SQL DECLARE C11815 CURSOR FOR S11815 END-EXEC DISPLAY" "
DISPLAY"OPEN C11815;" * EXEC SQL OPEN C11815; CALL"SUB77"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C11815 INTO :int1;" * EXEC SQL FETCH C11815 INTO :int1; CALL"SUB78"USING SQLCODE SQLSTATE int1 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 0; its value is ", int1 if (int1 NOT = 0) then MOVE 0 TO flag END-IF
DISPLAY"CLOSE C11815;" * EXEC SQL CLOSE C11815; CALL"SUB79"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
*...and disabled deletes just for good measure.
* EXEC SQL DELETE FROM CONCATBUF; CALL"SUB80"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD * EXEC SQL INSERT INTO CONCATBUF VALUES ( * 'DELETE FROM AUDIT_CODES' || * ' WHERE LUSER_ACTION = ''DELETE''' * ); CALL"SUB81"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD * EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF; CALL"SUB82"USING SQLCODE SQLSTATE longst MOVE SQLCODE TO SQL-COD
* EXEC SQL DELETE FROM CONCATBUF; CALL"SUB84"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD * EXEC SQL INSERT INTO CONCATBUF VALUES ( * 'SELECT COUNT(*) FROM AUDIT_RECORDS' || * ' WHERE ACTION_KEY = ?' * ); CALL"SUB85"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD * EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF; CALL"SUB86"USING SQLCODE SQLSTATE longst MOVE SQLCODE TO SQL-COD
DISPLAY"longst=""", longst """"
DISPLAY"PREPARE S11816 FROM :longst;" * EXEC SQL PREPARE S11816 FROM :longst; CALL"SUB87"USING SQLCODE SQLSTATE longst MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK DISPLAY" "
DISPLAY"DECLARE C11816 CURSOR FOR S11816;" * EXEC SQL DECLARE C11816 CURSOR FOR S11816 END-EXEC DISPLAY" "
MOVE 2 TO int2 DISPLAY"int2 = 2;" DISPLAY"OPEN C11816 USING :int2;" * EXEC SQL OPEN C11816 USING :int2; CALL"SUB88"USING SQLCODE SQLSTATE int2 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C11816 INTO :int1;" * EXEC SQL FETCH C11816 INTO :int1; CALL"SUB89"USING SQLCODE SQLSTATE int1 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 0; its value is ", int1 if (int1 NOT = 0) then MOVE 0 TO flag END-IF
DISPLAY"CLOSE C11816;" * EXEC SQL CLOSE C11816; CALL"SUB90"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
MOVE 0 TO int2 DISPLAY"int2 = 0;" DISPLAY"OPEN C11816 USING :int2;" * EXEC SQL OPEN C11816 USING :int2; CALL"SUB91"USING SQLCODE SQLSTATE int2 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C11816 INTO :int1;" * EXEC SQL FETCH C11816 INTO :int1; CALL"SUB92"USING SQLCODE SQLSTATE int1 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 8; its value is ", int1 if (int1 NOT = 8) then MOVE 0 TO flag END-IF
DISPLAY"CLOSE C11816;" * EXEC SQL CLOSE C11816; CALL"SUB93"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
*See if that "ON DELETE NO ACTION" did what it was supposed to d *It should _not_ allow us to create dangling references.
DISPLAY"dstmt=""DELETE FROM ALL_USER_IDS""" MOVE"DELETE FROM ALL_USER_IDS " TO dstmt
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 23000; its value is ", SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (NORMSQ NOT = "23000") then MOVE 0 TO flag END-IF if (NORMSQ = "23000"AND NORMSQ NOT = SQLSTATE) then DISPLAY"Valid implementation-defined SQLSTATE accepted." END-IF DISPLAY" "
* EXEC SQL COMMIT WORK; CALL"SUB108"USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD ******************** END TEST0646 ******************** **** 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 (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 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.
¤ Dauer der Verarbeitung: 0.26 Sekunden
(vorverarbeitet)
¤
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.