**************************************************************** * * COMMENT SECTION * * DATE 1994/6/8 EMBEDDED 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. * * DML122.PCO * WRITTEN BY: David W. Flater * TRANSLATED AUTOMATICALLY FROM EMBEDDED C BY CHRIS SCHANZLE * * This routine tests FIPS features 22 and 24 and datetime * errata. This is the dynamic version of DML121.PC. * * REFERENCES * FIPS PUB 127-2 14.1 Transitional SQL * ANSI SQL-1992 * ****************************************************************
MOVE"FLATER "TO uid CALL"AUTHID"USING uid MOVE"not logged in, not"TO uidx EXECSQLSELECT USER INTO :uidx FROM HU.ECCO END-EXEC MOVESQLCODETO SQL-COD EXECSQLROLLBACK WORK END-EXEC MOVESQLCODETO SQL-COD if (uid NOT = uidx) then DISPLAY"ERROR: User ", uid " expected. User ", uidx "
- " connected" STOPRUN END-IF MOVE 0 TO errcnt
DISPLAY "SQL Test Suite, V6.0, Embedded COBOL, dml122.pco" DISPLAY "59-byte ID" DISPLAY"TEd Version #" *date_time print ACCEPT TO-DAY FROMDATE ACCEPT THE-TIME FROMTIME DISPLAY"Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIME
******************** BEGIN TEST0650 ******************* MOVE 1 TO flag
DISPLAY" TEST0650 " DISPLAY" Feature 22, Explicit defaults (dynamic)" DISPLAY"References:" DISPLAY" FIPS PUB 127-2 14.1 Transitional SQL feature
- " 22" DISPLAY" 13.8 LR.2.d -- DEFAULT VALUES in an <insert
- " statement>" DISPLAY" 7.1 LR.2.a -- DEFAULT in a <row value
- " constructor>" DISPLAY" 11.5 LR.2.a -- various things in a <default
- " option>" DISPLAY" 13.9 LR.2.c -- DEFAULT in update statements" DISPLAY" - - - - - - - - - - - - - - - - - - -"
COMPUTESQLCODE = -1 MOVE"xxxxx"TO SQLSTATE
*This feature was tested for datetimes in TEST0631
*Feature 22 in 127-2 seems to imply that SYSTEM_USER and *SESSION_USER would be legal in a <default option>, but *this is obviously not the intention since Intermediate *feature 32 is where they are made legal in a <general *value specification>.
COMPUTE int1 = -1 DISPLAY"FETCH C12211 INTO :int1;" EXECSQL FETCH C12211 INTO :int1 END-EXEC 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 C12212 INTO :int1;" EXECSQL FETCH C12212 INTO :int1 END-EXEC 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 C12213 INTO :int1;" EXECSQL FETCH C12213 INTO :int1 END-EXEC 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 C12214 INTO :int1;" EXECSQL FETCH C12214 INTO :int1 END-EXEC 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
EXECSQLCOMMIT WORK END-EXEC MOVESQLCODETO SQL-COD ******************** END TEST0650 ******************** ******************** BEGIN TEST0652 ******************* MOVE 1 TO flag
*Saying 'GRANT SELECT ON TABLE VERBOSE_PEOPLE' when *VERBOSE_PEOPLE is a view is dubious practice, but it *serves to emphasize the fact that the optional keyword *has no semantics whatsoever and should be totally *ignored.
DISPLAY"dstmt=""GRANT SELECT ON TABLE VERBOSE_PEOPLE TO
- " PUBLIC""" MOVE"GRANT SELECT ON TABLE VERBOSE_PEOPLE TO PUBLIC " TO dstmt
MOVE"xxxxxxxxxxxxxxxxxxxx"TO name DISPLAY"We ought to get Alice, Betty, and Don."
.
P199. DISPLAY"FETCH FROM BEACH_PARTY INTO :name;" EXECSQL FETCH FROM BEACH_PARTY INTO :name END-EXEC MOVESQLCODETO SQL-COD DISPLAY"name is '", name "'" if (SQLCODE < 0) then PERFORM CHCKOK DISPLAY" " GOTO P198 END-IF if (SQLCODE > 0) then GOTO P197 END-IF PERFORM CHCKOK DISPLAY" " if (name = "Alice") then COMPUTE alice = alice + 1 GOTO P199 END-IF if (name = "Betty") then COMPUTE betty = betty + 1 GOTO P199 END-IF if (name = "Don") then COMPUTE don = don + 1 GOTO P199 END-IF MOVE 0 TO flag GOTO P199
.
P197. 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" "
.
P198. if (alice NOT = 1 OR betty NOT = 1 OR don NOT =
1) then MOVE 0 TO flag END-IF
EXECSQLCOMMIT WORK END-EXEC MOVESQLCODETO SQL-COD ******************** END TEST0652 ******************** ******************** BEGIN TEST0662 ******************* MOVE 1 TO flag
EXECSQLDELETEFROM CONCATBUF END-EXEC MOVESQLCODETO SQL-COD EXECSQLINSERTINTO CONCATBUF VALUES ( 'INSERT INTO LOTSA_DATETIMES (C12, C13) VALUES (' || ' CAST (? AS INTERVAL DAY TO MINUTE),' || ' CAST (? AS INTERVAL DAY TO SECOND))'
) END-EXEC MOVESQLCODETO SQL-COD EXECSQLSELECT ZZ INTO :longst FROM CONCATBUF END-EXEC MOVESQLCODETO SQL-COD
DISPLAY"longst=""", longst """"
DISPLAY"PREPARE S12235 FROM :longst;" EXECSQL PREPARE S12235 FROM :longst END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
DISPLAY"EXECUTE S12235 USING :ldt12, :ldt13;" EXECSQL EXECUTE S12235 USING :ldt12, :ldt13 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
EXECSQLDELETEFROM CONCATBUF END-EXEC MOVESQLCODETO SQL-COD EXECSQLINSERTINTO CONCATBUF VALUES ( 'INSERT INTO LOTSA_DATETIMES (C14, C15, C16) VALUES (' || ' CAST (? AS INTERVAL HOUR TO MINUTE),' || ' CAST (? AS INTERVAL HOUR TO SECOND),' || ' CAST (''-20:00'' AS INTERVAL MINUTE TO SECOND))'
) END-EXEC MOVESQLCODETO SQL-COD EXECSQLSELECT ZZ INTO :longst FROM CONCATBUF END-EXEC MOVESQLCODETO SQL-COD
DISPLAY"longst=""", longst """"
DISPLAY"PREPARE S12236 FROM :longst;" EXECSQL PREPARE S12236 FROM :longst END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
DISPLAY"EXECUTE S12236 USING :ldt14, :ldt15;" EXECSQL EXECUTE S12236 USING :ldt14, :ldt15 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"SELECT COUNT(*) INTO :int1" DISPLAY" FROM LOTSA_DATETIMES;" EXECSQLSELECTCOUNT(*) INTO :int1 FROM LOTSA_DATETIMES END-EXEC 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 C12232 INTO :int1;" EXECSQL FETCH C12232 INTO :int1 END-EXEC 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
EXECSQLCOMMIT WORK END-EXEC MOVESQLCODETO SQL-COD ******************** END TEST0662 ******************** ******************** BEGIN TEST0664 ******************* MOVE 1 TO flag
DISPLAY"EXECUTE S12241 USING :ldt2, :ldt3:indic1;" EXECSQL EXECUTE S12241 USING :ldt2, :ldt3:indic1 END-EXEC 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 22007; its value is ", SQLSTATE if (SQLSTATE NOT = "22007") then MOVE 0 TO flag END-IF
*Invalid interval format 22006
DISPLAY"EXECUTE S12241 USING :ldt2:indic1, :ldt3;" EXECSQL EXECUTE S12241 USING :ldt2:indic1, :ldt3 END-EXEC 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 22006; its value is ", SQLSTATE if (SQLSTATE NOT = "22006") then MOVE 0 TO flag END-IF
DISPLAY"COMMIT WORK;" EXECSQLCOMMIT WORK END-EXEC MOVESQLCODETO SQL-COD
EXECSQLCOMMIT WORK END-EXEC MOVESQLCODETO SQL-COD ******************** END TEST0664 ******************** **** 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.22 Sekunden
(vorverarbeitet am 2026-04-26)
¤
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.