* Standard COBOL (file "DML115.SCO") calling SQL * procedures in file "DML115.MCO".
**************************************************************** * * COMMENT SECTION * * DATE 1994/4/8 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. * * DML115.SCO * WRITTEN BY: David W. Flater * TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE * * This routine tests FIPS features 13, 14, 15, and 16. * This is the dynamic version of DML114.PC. * * REFERENCES * FIPS PUB 127-2 14.1 Transitional SQL * ANSI SQL-1992 * ****************************************************************
MOVE"xyz"TO ch1 DISPLAY"FETCH C11511 INTO :ch1, :int1;" * EXEC SQL FETCH C11511 INTO :ch1, :int1; CALL"SUB14"USINGSQLCODE SQLSTATE ch1 int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"ch1 should be 'E1 '; its value is '", ch1 "'" DISPLAY"int1 should be 120; its value is ", int1 if (ch1 NOT = "E1 "OR int1 NOT = 120) then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C11512 INTO :int1;" * EXEC SQL FETCH C11512 INTO :int1; CALL"SUB18"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
MOVE"aaaaaaaaaaaaaaaaaaaa"TO ch2 DISPLAY"FETCH C11513 INTO :ch2;" * EXEC SQL FETCH C11513 INTO :ch2; CALL"SUB25"USINGSQLCODE SQLSTATE ch2 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"ch2 should be Alice; its value is ", ch2 if (ch2 NOT = "Alice") then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 COMPUTE int2 = -1 MOVE"xxx"TO ch1 MOVE"xxx"TO ch4 DISPLAY"FETCH C11514 INTO :int1, :ch1, :ch4, :int2;" * EXEC SQL FETCH C11514 INTO :int1, :ch1, :ch4, :int2 * ; CALL"SUB32"USINGSQLCODE SQLSTATE int1 ch1 ch4 int2 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 10; its value is ", int1 DISPLAY"ch1 should be 'E4 '; its value is '", ch1 "'" DISPLAY"ch4 should be 'E1 '; its value is '", ch4 "'" DISPLAY"int2 should be 43; its value is ", int2 if (int1 NOT = 10 OR ch1 NOT = "E4 ") then MOVE 0 TO flag END-IF if (ch4 NOT = "E1 "OR int2 NOT = 43) then MOVE 0 TO flag END-IF
MOVE"aaaaaaaaaaaaaaaaaaaa"TO ch2 DISPLAY"FETCH C11515 INTO :ch2;" * EXEC SQL FETCH C11515 INTO :ch2; CALL"SUB39"USINGSQLCODE SQLSTATE ch2 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"ch2 should be Alice; its value is ", ch2 if (ch2 NOT = "Alice") then MOVE 0 TO flag END-IF
MOVE"aaaaaaaaaaaaaaaaaaaa"TO ch2 DISPLAY"FETCH C11516 INTO :ch2;" * EXEC SQL FETCH C11516 INTO :ch2; CALL"SUB46"USINGSQLCODE SQLSTATE ch2 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"ch2 should be Alice; its value is ", ch2 if (ch2 NOT = "Alice") then MOVE 0 TO flag END-IF
.
P100. COMPUTE int1 = -1 DISPLAY"FETCH C11517 INTO :int1;" * EXEC SQL FETCH C11517 INTO :int1; CALL"SUB50"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD DISPLAY"SQLCODE is ", SQL-COD DISPLAY"SQLSTATE is ", SQLSTATE if (SQLCODENOT = 0) then GOTO P101 END-IF DISPLAY"int1 is ", int1 COMPUTE ctr3 = ctr3 - 1 if (int1 = 1) then COMPUTE ctr2 = ctr2 - 1 END-IF if (int1 = 3) then COMPUTE ctr1 = ctr1 - 1 END-IF GOTO P100
.
P101. if (ctr1 NOT = 0 OR ctr2 NOT = 0 OR ctr3 NOT = 0) then MOVE 0 TO flag END-IF 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" "
COMPUTE int1 = -1 DISPLAY"FETCH C11521 INTO :int1;" * EXEC SQL FETCH C11521 INTO :int1; CALL"SUB83"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 12; its value is ", int1 if (int1 NOT = 12) then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C11522 INTO :int1;" * EXEC SQL FETCH C11522 INTO :int1; CALL"SUB87"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 10; its value is ", int1 if (int1 NOT = 10) then MOVE 0 TO flag END-IF
MOVE"xxx"TO ch1 MOVE"xxxxxxxxxxxxxxx"TO ch3 COMPUTE int1 = -1 COMPUTE int2 = -1 DISPLAY"FETCH C11523 INTO :ch1, :int1, :ch3, :int2;" * EXEC SQL FETCH C11523 INTO :ch1, :int1, :ch3, :int2 * ; CALL"SUB94"USINGSQLCODE SQLSTATE ch1 int1 ch3 int2 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"ch1 should be 'E3 '; its value is '", ch1 "'" if (ch1 NOT = "E3 ") then MOVE 0 TO flag END-IF DISPLAY"int1 should be 13; its value is ", int1 if (int1 NOT = 13) then MOVE 0 TO flag END-IF DISPLAY"ch3 should be 'Vienna '; its value is '",
ch3 "'" if (ch3 NOT = "Vienna ") then MOVE 0 TO flag END-IF DISPLAY"int2 should be 20; its value is ", int2 if (int2 NOT = 20) then MOVE 0 TO flag END-IF
MOVE"xxx"TO ch1 MOVE"xxxxxxxxxxxxxxxxxxxx"TO ch2 MOVE"xxxxxxxxxxxxxxx"TO ch3 COMPUTE int1 = -1 COMPUTE int2 = -1 DISPLAY"FETCH CJOANS INTO :ch1, :ch2, :int1, :ch3, :int2;" * EXEC SQL FETCH CJOANS INTO :ch1, :ch2, :int1, :ch3, :int2 * ; CALL"SUB101"USINGSQLCODE SQLSTATE ch1 ch2 int1 ch3 int2 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"ch1 should be 'E3 '; its value is '", ch1 "'" if (ch1 NOT = "E3 ") then MOVE 0 TO flag END-IF DISPLAY"ch2 should be 'Carmen '; its value is
- " '", ch2 "'" if (ch2 NOT = "Carmen ") then MOVE 0 TO flag END-IF DISPLAY"int1 should be 13; its value is ", int1 if (int1 NOT = 13) then MOVE 0 TO flag END-IF DISPLAY"ch3 should be 'Vienna '; its value is '",
ch3 "'" if (ch3 NOT = "Vienna ") then MOVE 0 TO flag END-IF DISPLAY"int2 should be 20; its value is ", int2 if (int2 NOT = 20) then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C11524 INTO :int1;" * EXEC SQL FETCH C11524 INTO :int1; CALL"SUB105"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 12; its value is ", int1 if (int1 NOT = 12) then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C11525 INTO :int1;" * EXEC SQL FETCH C11525 INTO :int1; CALL"SUB109"USINGSQLCODE SQLSTATE int1 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 10; its value is ", int1 if (int1 NOT = 10) then MOVE 0 TO flag END-IF
MOVE"xxx"TO ch1 MOVE"xxxxxxxxxxxxxxx"TO ch3 COMPUTE int1 = -1 COMPUTE int2 = -1 DISPLAY"FETCH C11526 INTO :ch1, :int1, :ch3, :int2;" * EXEC SQL FETCH C11526 INTO :ch1, :int1, :ch3, :int2 * ; CALL"SUB116"USINGSQLCODE SQLSTATE ch1 int1 ch3 int2 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"ch1 should be 'E3 '; its value is '", ch1 "'" if (ch1 NOT = "E3 ") then MOVE 0 TO flag END-IF DISPLAY"int1 should be 13; its value is ", int1 if (int1 NOT = 13) then MOVE 0 TO flag END-IF DISPLAY"ch3 should be 'Vienna '; its value is '",
ch3 "'" if (ch3 NOT = "Vienna ") then MOVE 0 TO flag END-IF DISPLAY"int2 should be 20; its value is ", int2 if (int2 NOT = 20) then MOVE 0 TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C11531 INTO :int1;" * EXEC SQL FETCH C11531 INTO :int1; CALL"SUB135"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
MOVE"xxx"TO ch1 MOVE"xxxxxxxxxxxxxxx"TO ch3 COMPUTE int1 = -1 DISPLAY"FETCH C11532 INTO :ch1, :int1, :ch3;" * EXEC SQL FETCH C11532 INTO :ch1, :int1, :ch3; CALL"SUB142"USINGSQLCODE SQLSTATE ch1 int1 ch3 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"ch1 should be 'E3 '; its value is '", ch1 "'" if (ch1 NOT = "E3 ") then MOVE 0 TO flag END-IF DISPLAY"int1 should be 13; its value is ", int1 if (int1 NOT = 13) then MOVE 0 TO flag END-IF DISPLAY"ch3 should be 'Vienna '; its value is '",
ch3 "'" if (ch3 NOT = "Vienna ") then MOVE 0 TO flag END-IF
DISPLAY"dstmt=""INSERT INTO FEAT16 VALUES (?, ?)""" MOVE"INSERT INTO FEAT16 VALUES (?, ?) " TO dstmt
DISPLAY"PREPARE S11541 FROM :dstmt;" * EXEC SQL PREPARE S11541 FROM :dstmt; CALL"SUB156"USINGSQLCODE SQLSTATE dstmt MOVESQLCODETO SQL-COD
PERFORM CHCKOK DISPLAY" "
MOVE 1 TO int1 MOVE 10 TO int2 DISPLAY"int1 = ", int1 "; int2 = ", int2 DISPLAY"EXECUTE S11541 USING :int1, :int2;" * EXEC SQL EXECUTE S11541 USING :int1, :int2; CALL"SUB157"USINGSQLCODE SQLSTATE int1 int2 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
MOVE 2 TO int1 MOVE 20 TO int2 DISPLAY"int1 = ", int1 "; int2 = ", int2 DISPLAY"EXECUTE S11541 USING :int1, :int2;" * EXEC SQL EXECUTE S11541 USING :int1, :int2; CALL"SUB158"USINGSQLCODE SQLSTATE int1 int2 MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
MOVE 1 TO int1 MOVE 30 TO int2 DISPLAY"int1 = ", int1 "; int2 = ", int2 DISPLAY"EXECUTE S11541 USING :int1, :int2;" * EXEC SQL EXECUTE S11541 USING :int1, :int2; CALL"SUB159"USINGSQLCODE SQLSTATE int1 int2 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 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" "
MOVE 3 TO int1 MOVE 20 TO int2 DISPLAY"int1 = ", int1 "; int2 = ", int2 DISPLAY"EXECUTE S11541 USING :int1, :int2;" * EXEC SQL EXECUTE S11541 USING :int1, :int2; CALL"SUB160"USINGSQLCODE SQLSTATE int1 int2 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 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"SUB169"USINGSQLCODE SQLSTATE MOVESQLCODETO SQL-COD ******************** END TEST0642 ******************** **** 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.18Bemerkung:
(vorverarbeitet am 2026-05-02)
¤
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.