**************************************************************** * * COMMENT SECTION * * DATE 1993/08/16 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. * * DML105.PCO * WRITTEN BY: David W. Flater * TRANSLATED AUTOMATICALLY FROM EMBEDDED C BY CHRIS SCHANZLE * * This routine tests Fips Feature #4 for dynamic TSQL. Fips * Feature #4 is "joined table." * * REFERENCES * FIPS PUB 127-2 14.1 Transitional SQL * ANSI SQL-1992 7.5 <joined table> * ****************************************************************
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 MOVE0TO errcnt
DISPLAY "SQL Test Suite, V6.0, Embedded COBOL, dml105.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 TEST0595 ******************* MOVE1TO flag
DISPLAY"OPEN C10511 USING :cvar1, :ivar1;" EXECSQLOPEN C10511 USING :cvar1, :ivar1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C10511 INTO :int1;" EXECSQL FETCH C10511 INTO :int1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 0; its value is ", int1 if (int1 NOT = 0) then MOVE0TO flag END-IF
DISPLAY"OPEN C10511 USING :cvar1, :ivar1;" EXECSQLOPEN C10511 USING :cvar1, :ivar1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C10511 INTO :int1;" EXECSQL FETCH C10511 INTO :int1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 1; its value is ", int1 if (int1 NOT = 1) then MOVE0TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C10512 INTO :int1;" EXECSQL FETCH C10512 INTO :int1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 0; its value is ", int1 if (int1 NOT = 0) then MOVE0TO flag END-IF
EXECSQLCOMMIT WORK END-EXEC MOVESQLCODETO SQL-COD ******************** END TEST0595 ******************** ******************** BEGIN TEST0596 ******************* MOVE1TO flag
DISPLAY"OPEN C10521 USING :cvar1, :ivar1;" EXECSQLOPEN C10521 USING :cvar1, :ivar1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C10521 INTO :int1;" EXECSQL FETCH C10521 INTO :int1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 0; its value is ", int1 if (int1 NOT = 0) then MOVE0TO flag END-IF
DISPLAY"OPEN C10521 USING :cvar1, :ivar1;" EXECSQLOPEN C10521 USING :cvar1, :ivar1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C10521 INTO :int1;" EXECSQL FETCH C10521 INTO :int1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 1; its value is ", int1 if (int1 NOT = 1) then MOVE0TO flag END-IF
EXECSQLDELETEFROM CONCATBUF END-EXEC MOVESQLCODETO SQL-COD EXECSQLINSERTINTO CONCATBUF VALUES ( 'SELECT COUNT(*) FROM NAMGRP2 ' || ' WHERE NAAM <> ''MARY''' || ' AND NAAM <> ''KERI''' || ' OR GRP <> 20 ' || ' AND GRP <> 10 ' || ' OR EMPNUM <> 0 ' || ' AND EMPNUM <> 1 ' || ' OR NAAM IS NULL ' || ' OR GRP IS NULL ' || ' OR EMPNUM IS NULL'
) END-EXEC MOVESQLCODETO SQL-COD EXECSQLSELECT ZZ INTO :longst FROM CONCATBUF END-EXEC MOVESQLCODETO SQL-COD
DISPLAY"longst=""", longst """"
DISPLAY"PREPARE S10522 FROM :longst;" EXECSQL PREPARE S10522 FROM :longst END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
DISPLAY"DECLARE C10522 CURSOR FOR S10522;" EXECSQL DECLARE C10522 CURSOR FOR S10522 END-EXEC DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C10522 INTO :int1;" EXECSQL FETCH C10522 INTO :int1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 0; its value is ", int1 if (int1 NOT = 0) then MOVE0TO flag END-IF
DISPLAY"OPEN C10524 USING :cvar1, :ivar1;" EXECSQLOPEN C10524 USING :cvar1, :ivar1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C10524 INTO :int1;" EXECSQL FETCH C10524 INTO :int1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 1; its value is ", int1 if (int1 NOT = 1) then MOVE0TO flag END-IF
EXECSQLDELETEFROM CONCATBUF END-EXEC MOVESQLCODETO SQL-COD EXECSQLINSERTINTO CONCATBUF VALUES ( 'SELECT COUNT(*) FROM NMGRP2 ' || ' WHERE NAAM <> ''MARY''' || ' OR GRP <> 20 ' || ' OR EMPNUM <> 1 ' || ' OR NAAM IS NULL ' || ' OR GRP IS NULL ' || ' OR EMPNUM IS NULL'
) END-EXEC MOVESQLCODETO SQL-COD EXECSQLSELECT ZZ INTO :longst FROM CONCATBUF END-EXEC MOVESQLCODETO SQL-COD
DISPLAY"longst=""", longst """"
DISPLAY"PREPARE S10523 FROM :longst;" EXECSQL PREPARE S10523 FROM :longst END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
DISPLAY"DECLARE C10523 CURSOR FOR S10523;" EXECSQL DECLARE C10523 CURSOR FOR S10523 END-EXEC DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C10523 INTO :int1;" EXECSQL FETCH C10523 INTO :int1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 0; its value is ", int1 if (int1 NOT = 0) then MOVE0TO flag END-IF
EXECSQLCOMMIT WORK END-EXEC MOVESQLCODETO SQL-COD ******************** END TEST0596 ******************** ******************** BEGIN TEST0597 ******************* MOVE1TO flag
*This is just to see if ON is also supported EXECSQLDELETEFROM CONCATBUF END-EXEC MOVESQLCODETO SQL-COD EXECSQLINSERTINTO CONCATBUF VALUES ( 'CREATE VIEW NMGRP3 AS'
|| ' SELECT NAAM, GRP FROM NAMES3 LEFT OUTER JOIN GROUPS3'
|| ' ON NAMES3.EMPNUM < GROUPS3.EMPNUM'
|| ' WHERE NAAM <> ''KERI'''
) END-EXEC MOVESQLCODETO SQL-COD EXECSQLSELECT ZZ INTO :longst FROM CONCATBUF END-EXEC MOVESQLCODETO SQL-COD
DISPLAY"OPEN C10531 USING :ivar2, :cvar1, :ivar1;" EXECSQLOPEN C10531 USING :ivar2, :cvar1, :ivar1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C10531 INTO :int1;" EXECSQL FETCH C10531 INTO :int1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 1; its value is ", int1 if (int1 NOT = 1) then MOVE0TO flag END-IF
DISPLAY"OPEN C10531 USING :ivar2, :cvar1, :ivar1;" EXECSQLOPEN C10531 USING :ivar2, :cvar1, :ivar1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C10531 INTO :int1;" EXECSQL FETCH C10531 INTO :int1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 1; its value is ", int1 if (int1 NOT = 1) then MOVE0TO flag END-IF
DISPLAY"OPEN C10533 USING :ivar1, :cvar1;" EXECSQLOPEN C10533 USING :ivar1, :cvar1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C10533 INTO :int1;" EXECSQL FETCH C10533 INTO :int1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 1; its value is ", int1 if (int1 NOT = 1) then MOVE0TO flag END-IF
DISPLAY"OPEN C10533 USING :ivar1, :cvar1;" EXECSQLOPEN C10533 USING :ivar1, :cvar1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C10533 INTO :int1;" EXECSQL FETCH C10533 INTO :int1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 1; its value is ", int1 if (int1 NOT = 1) then MOVE0TO flag END-IF
DISPLAY"OPEN C10533 USING :ivar1, :cvar1;" EXECSQLOPEN C10533 USING :ivar1, :cvar1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C10533 INTO :int1;" EXECSQL FETCH C10533 INTO :int1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 1; its value is ", int1 if (int1 NOT = 1) then MOVE0TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C10532 INTO :int1;" EXECSQL FETCH C10532 INTO :int1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 5; its value is ", int1 if (int1 NOT = 5) then MOVE0TO flag END-IF
EXECSQLDELETEFROM CONCATBUF END-EXEC MOVESQLCODETO SQL-COD EXECSQLINSERTINTO CONCATBUF VALUES ( 'SELECT COUNT(*) FROM NMGRP3 WHERE' || ' NAAM = ''MARY'' AND GRP = ?'
) END-EXEC MOVESQLCODETO SQL-COD EXECSQLSELECT ZZ INTO :longst FROM CONCATBUF END-EXEC MOVESQLCODETO SQL-COD
DISPLAY"longst=""", longst """"
DISPLAY"PREPARE S10534 FROM :longst;" EXECSQL PREPARE S10534 FROM :longst END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
DISPLAY"DECLARE C10534 CURSOR FOR S10534;" EXECSQL DECLARE C10534 CURSOR FOR S10534 END-EXEC DISPLAY" "
DISPLAY"ivar1 = 30;" MOVE30TO ivar1
DISPLAY"OPEN C10534 USING :ivar1;" EXECSQLOPEN C10534 USING :ivar1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C10534 INTO :int1;" EXECSQL FETCH C10534 INTO :int1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 1; its value is ", int1 if (int1 NOT = 1) then MOVE0TO flag END-IF
DISPLAY"OPEN C10534 USING :ivar1;" EXECSQLOPEN C10534 USING :ivar1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C10534 INTO :int1;" EXECSQL FETCH C10534 INTO :int1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 1; its value is ", int1 if (int1 NOT = 1) then MOVE0TO flag END-IF
EXECSQLDELETEFROM CONCATBUF END-EXEC MOVESQLCODETO SQL-COD EXECSQLINSERTINTO CONCATBUF VALUES ( 'SELECT COUNT(*) FROM NMGRP3 WHERE' || ' NAAM = ? AND GRP IS NULL'
) END-EXEC MOVESQLCODETO SQL-COD EXECSQLSELECT ZZ INTO :longst FROM CONCATBUF END-EXEC MOVESQLCODETO SQL-COD
DISPLAY"longst=""", longst """"
DISPLAY"PREPARE S10535 FROM :longst;" EXECSQL PREPARE S10535 FROM :longst END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
DISPLAY"DECLARE C10535 CURSOR FOR S10535;" EXECSQL DECLARE C10535 CURSOR FOR S10535 END-EXEC DISPLAY" "
MOVE"BARRY"TO cvar1
DISPLAY"OPEN C10535 USING :cvar1;" EXECSQLOPEN C10535 USING :cvar1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C10535 INTO :int1;" EXECSQL FETCH C10535 INTO :int1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 1; its value is ", int1 if (int1 NOT = 1) then MOVE0TO flag END-IF
DISPLAY"OPEN C10535 USING :cvar1;" EXECSQLOPEN C10535 USING :cvar1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C10535 INTO :int1;" EXECSQL FETCH C10535 INTO :int1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 1; its value is ", int1 if (int1 NOT = 1) then MOVE0TO flag END-IF
DISPLAY"OPEN C10535 USING :cvar1;" EXECSQLOPEN C10535 USING :cvar1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C10535 INTO :int1;" EXECSQL FETCH C10535 INTO :int1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 1; its value is ", int1 if (int1 NOT = 1) then MOVE0TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C10536 INTO :int1;" EXECSQL FETCH C10536 INTO :int1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 5; its value is ", int1 if (int1 NOT = 5) then MOVE0TO flag END-IF
EXECSQLCOMMIT WORK END-EXEC MOVESQLCODETO SQL-COD ******************** END TEST0597 ******************** ******************** BEGIN TEST0598 ******************* MOVE1TO flag
DISPLAY"OPEN C10541 USING :ivar2, :cvar1, :ivar1;" EXECSQLOPEN C10541 USING :ivar2, :cvar1, :ivar1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C10541 INTO :int1;" EXECSQL FETCH C10541 INTO :int1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 1; its value is ", int1 if (int1 NOT = 1) then MOVE0TO flag END-IF
DISPLAY"OPEN C10541 USING :ivar2, :cvar1, :ivar1;" EXECSQLOPEN C10541 USING :ivar2, :cvar1, :ivar1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C10541 INTO :int1;" EXECSQL FETCH C10541 INTO :int1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 1; its value is ", int1 if (int1 NOT = 1) then MOVE0TO flag END-IF
DISPLAY"OPEN C10542 USING :ivar1, :ivar2;" EXECSQLOPEN C10542 USING :ivar1, :ivar2 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C10542 INTO :int1;" EXECSQL FETCH C10542 INTO :int1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 1; its value is ", int1 if (int1 NOT = 1) then MOVE0TO flag END-IF
DISPLAY"OPEN C10542 USING :ivar1, :ivar2;" EXECSQLOPEN C10542 USING :ivar1, :ivar2 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
COMPUTE int1 = -1 DISPLAY"FETCH C10542 INTO :int1;" EXECSQL FETCH C10542 INTO :int1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 1; its value is ", int1 if (int1 NOT = 1) then MOVE0TO flag END-IF
COMPUTE int1 = -1 DISPLAY"FETCH C10543 INTO :int1;" EXECSQL FETCH C10543 INTO :int1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"int1 should be 4; its value is ", int1 if (int1 NOT = 4) then MOVE0TO flag END-IF
EXECSQLCOMMIT WORK END-EXEC MOVESQLCODETO SQL-COD ******************** END TEST0598 ********************
**** 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 = 0OR NORMSQ NOT = "00000") then MOVE0TO 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
MOVE3TO norm1 *subclass begins in position 3 of char array NORMSQ *valid subclass begins with 5-9, I-Z, end of ALPNUM table PERFORMVARYING norm2 FROM14BY1UNTIL 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
MOVE4TO norm1 *examining position 4 of char array NORMSQ *valid characters are 0-9, A-Z PERFORMVARYING norm2 FROM1BY1UNTIL norm2 > 36 if (NORMSQX(norm1) = ALPNUM(norm2)) then MOVE"0"TO NORMSQX(norm1) END-IF END-PERFORM
MOVE5TO norm1 *valid characters are 0-9, A-Z *examining position 5 of char array NORMSQ PERFORMVARYING norm2 FROM1BY1UNTIL 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.31 Sekunden
(vorverarbeitet am 2026-06-10)
¤
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.