* Standard COBOL (file "DML111.SCO") calling SQL * procedures in file "DML111.MCO".
**************************************************************** * * COMMENT SECTION * * DATE 1993/11/17 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. * * DML111.SCO * WRITTEN BY: David W. Flater * TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE * * This routine tests DATETIME features in Transitional * SQL with cursors. This is the dynamic version of * DML110. * * REFERENCES * FIPS PUB 127-2 14.1 Transitional SQL * ANSI SQL-1992 * ****************************************************************
COMPUTE int1 = -1 MOVE 0 TO int2 MOVE 0 TO int3 DISPLAY"FETCH C11111 INTO :int1;" * EXEC SQL FETCH C11111 INTO :int1; CALL"SUB23"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 is ", int1 if (int1 = 0) then COMPUTE int2 = int2 + 1 END-IF if (int1 = 30) then COMPUTE int3 = int3 + 1 END-IF COMPUTE int1 = -1 DISPLAY"FETCH C11111 INTO :int1;" * EXEC SQL FETCH C11111 INTO :int1; CALL"SUB24"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 is ", int1 if (int1 = 0) then COMPUTE int2 = int2 + 1 END-IF if (int1 = 30) then COMPUTE int3 = int3 + 1 END-IF COMPUTE int1 = -1 DISPLAY"FETCH C11111 INTO :int1;" * EXEC SQL FETCH C11111 INTO :int1; CALL"SUB25"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 is ", int1 if (int1 = 0) then COMPUTE int2 = int2 + 1 END-IF if (int1 = 30) then COMPUTE int3 = int3 + 1 END-IF DISPLAY"FETCH C11111 INTO :int1;" * EXEC SQL FETCH C11111 INTO :int1; CALL"SUB26"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD DISPLAY"SQLCODE should be 100; its value is ", SQL-COD DISPLAY"SQLSTATE should be 02000; its value is ", SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (SQLCODENOT = 100 OR NORMSQ NOT = "02000") then MOVE 0 TO flag END-IF if (NORMSQ = "02000"AND NORMSQ NOT = SQLSTATE) then DISPLAY"Valid implementation-defined SQLSTATE accepted." END-IF DISPLAY"int1 should have shown 0 twice and 30 once." DISPLAY"There were ", int2 " 0(s) and ", int3 " 30(s)." if (int2 NOT = 2 OR int3 NOT = 1) then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C11111 INTO :int1;" * EXEC SQL FETCH C11111 INTO :int1; CALL"SUB29"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 is ", int1
*<preparable dynamic update statement: positioned> is Full SQL
*Jim Melton says that the "dynamic" positioned updates and *deletes have to pass the compiler despite the unquoted presence *of a table name that isn't known at compile time.
DISPLAY"UPDATE TEMPS" DISPLAY" SET LUNCH = INTERVAL '0:45' HOUR TO MINUTE" DISPLAY" WHERE CURRENT OF C11111;" * EXEC SQL UPDATE TEMPS * SET LUNCH = INTERVAL '0:45' HOUR TO MINUTE * WHERE CURRENT OF C11111; CALL"SUB30"USINGSQLCODE SQLSTATE MOVESQLCODETO SQL-COD
COMPUTE int1 = -1 DISPLAY"FETCH C11113 INTO :int1;" * EXEC SQL FETCH C11113 INTO :int1; CALL"SUB37"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 C11114 INTO :int1;" * EXEC SQL FETCH C11114 INTO :int1; CALL"SUB44"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 C11115 INTO :int1;" * EXEC SQL FETCH C11115 INTO :int1; CALL"SUB51"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 is ", int1
*Jim Melton says that the "dynamic" positioned updates and *deletes have to pass the compiler despite the unquoted presence *of a table name that isn't known at compile time.
DISPLAY"DELETE FROM TEMPS" DISPLAY" WHERE CURRENT OF C11115;" * EXEC SQL DELETE FROM TEMPS * WHERE CURRENT OF C11115; CALL"SUB52"USINGSQLCODE SQLSTATE MOVESQLCODETO SQL-COD
COMPUTE int1 = -1 DISPLAY"FETCH C11114 INTO :int1;" * EXEC SQL FETCH C11114 INTO :int1; CALL"SUB55"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 C11116 INTO :int1;" * EXEC SQL FETCH C11116 INTO :int1; CALL"SUB59"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
* EXEC SQL COMMIT WORK; CALL"SUB65"USINGSQLCODE SQLSTATE MOVESQLCODETO SQL-COD ******************** END TEST0620 ******************** **** 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
¤ Dauer der Verarbeitung: 0.3 Sekunden
(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.