**************************************************************** * * COMMENT SECTION * * DATE 1995/12/11 EMBEDDED COBOL LANGUAGE * 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. * * DML160.PCO * WRITTEN BY: David Flater * TRANSLATED AUTOMATICALLY FROM EMBEDDED C BY CHRIS SCHANZLE * * This routine tests joined tables. * * REFERENCES * FIPS PUB 127-2 14.2 Intermediate 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, dml160.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 TEST0859 ******************* MOVE 1 TO flag
MOVE"xxx"TO emnum COMPUTE cnth = -1 DISPLAY"FETCH C16011 INTO :emnum, :cnth;" EXECSQL FETCH C16011 INTO :emnum, :cnth END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"emnum should be 'E5 '; its value is '", emnum, "'" DISPLAY"cnth should be 0; its value is ", cnth if (emnum NOT = "E5 "OR cnth NOT = 0) then MOVE 0 TO flag END-IF
MOVE"xxx"TO emnum COMPUTE cnth = -1 DISPLAY"FETCH C16011 INTO :emnum, :cnth;" EXECSQL FETCH C16011 INTO :emnum, :cnth END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"emnum should be 'E2 '; its value is '", emnum, "'" DISPLAY"cnth should be 1; its value is ", cnth if (emnum NOT = "E2 "OR cnth NOT = 1) then MOVE 0 TO flag END-IF
MOVE"xxx"TO emnum COMPUTE cnth = -1 DISPLAY"FETCH C16011 INTO :emnum, :cnth;" EXECSQL FETCH C16011 INTO :emnum, :cnth END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"emnum should be 'E3 '; its value is '", emnum, "'" DISPLAY"cnth should be 1; its value is ", cnth if (emnum NOT = "E3 "OR cnth NOT = 1) then MOVE 0 TO flag END-IF
MOVE"xxx"TO emnum COMPUTE cnth = -1 DISPLAY"FETCH C16011 INTO :emnum, :cnth;" EXECSQL FETCH C16011 INTO :emnum, :cnth END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"emnum should be 'E4 '; its value is '", emnum, "'" DISPLAY"cnth should be 2; its value is ", cnth if (emnum NOT = "E4 "OR cnth NOT = 2) then MOVE 0 TO flag END-IF
MOVE"xxx"TO emnum COMPUTE cnth = -1 DISPLAY"FETCH C16011 INTO :emnum, :cnth;" EXECSQL FETCH C16011 INTO :emnum, :cnth END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"emnum should be 'E1 '; its value is '", emnum, "'" DISPLAY"cnth should be 4; its value is ", cnth if (emnum NOT = "E1 "OR cnth NOT = 4) then MOVE 0 TO flag END-IF
EXECSQLCOMMIT WORK END-EXEC MOVESQLCODETO SQL-COD ******************** END TEST0859 ******************** ******************** BEGIN TEST0860 ******************* MOVE 1 TO flag
DISPLAY" TEST0860" DISPLAY" Domains over various data types" DISPLAY"References:" DISPLAY" F# 25 -- Domain definition" DISPLAY" F# 41 -- Time zone specification" DISPLAY" F# 5 -- DATETIME data types" DISPLAY" F# 6 -- VARCHAR data type" DISPLAY" F# 8 -- Union in views" DISPLAY" F# 17 -- Multiple schemas per user" DISPLAY" F# 20 -- CAST functions" DISPLAY" - - - - - - - - - - - - - - - - - - -"
COMPUTESQLCODE = -1 MOVE"xxxxx"TO SQLSTATE
*Some people insist on using epochs outside of the traditional *0 to 360 range, so may as well use implementation-defined *precision too. DISPLAY"CREATE DOMAIN EPOCH_NOT_NORM AS DECIMAL (5, 2);" * EXEC SQL CREATE DOMAIN EPOCH_NOT_NORM AS DECIMAL (5, 2) * END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
*We only have data for 1994 through 2025 DISPLAY"CREATE DOMAIN TIDEDATE AS DATE" DISPLAY" CHECK (VALUE BETWEEN DATE '1994-01-01' AND DATE
- " '2025-12-31');" * EXEC SQL CREATE DOMAIN TIDEDATE AS DATE * CHECK (VALUE BETWEEN DATE '1994-01-01' AND DATE * '2025-12-31') END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
*...and furthermore, we have very specific notions about dinner. DISPLAY"CREATE DOMAIN DINNERTIME AS TIME" DISPLAY" CHECK (VALUE BETWEEN TIME '17:30:00' AND TIME
- " '19:00:00');" EXECSQL CREATE DOMAIN DINNERTIME AS TIME
CHECK (VALUE BETWEEN TIME'17:30:00'ANDTIME'19:00:00') END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
*Re-invent the wheel in our default schema because we have non- *normalized data and think in radians. Eventually the non- *normalized data will be normalized and moved into the main *schema (we hope).
*First try out the DOUBLE PRECISION and INTERVAL domains that ar *already in TIDES.
MOVE 500 TO xhour MOVE 500 TO xminit DISPLAY"SELECT EXTRACT (HOUR FROM MERIDIAN), EXTRACT" DISPLAY" (MINUTE FROM MERIDIAN) INTO :xhour, :xminit" DISPLAY" FROM TIDES.LOCATIONS WHERE LOC_NAME LIKE '", , "ewfound", ";" EXECSQLSELECT EXTRACT (HOUR FROM MERIDIAN), EXTRACT
(MINUTE FROM MERIDIAN) INTO :xhour, :xminit FROM TIDES.LOCATIONS WHERE LOC_NAME LIKE '%Newfound%' END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK *Sign of results specified by 6.6 GR.3.a.i DISPLAY"xhour should be -3; its value is ", xhour DISPLAY"xminit should be -30; its value is ", xminit if (xhour NOT = -3 OR xminit NOT = -30) then MOVE 0 TO flag END-IF
*There is no GMT-13. Violation of domain constraint 9.2 GR.4 *Integrity constraint violation
DISPLAY"INSERT INTO TIDES.LOCATIONS VALUES (" DISPLAY" 300, 'Atlantis', 160.0000, 3.0000, 0, 1.2E0," DISPLAY" INTERVAL -'13:00' HOUR TO MINUTE, 'GMT-13');" EXECSQLINSERTINTO TIDES.LOCATIONS VALUES (
300, 'Atlantis', 160.0000, 3.0000, 0, 1.2E0,
INTERVAL -'13:00' HOUR TO MINUTE, 'GMT-13') 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 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" "
*Negative amplitudes also illegal
DISPLAY"UPDATE TIDES.CONSTITUENTS" DISPLAY" SET AMPLITUDE = - AMPLITUDE" DISPLAY" WHERE LOC_ID = 100" DISPLAY" AND CONST_ID = 0;" EXECSQL UPDATE TIDES.CONSTITUENTS SET AMPLITUDE = - AMPLITUDE WHERE LOC_ID = 100 AND CONST_ID = 0 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 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" "
DISPLAY"INSERT INTO TIDES.CONSTITUENTS VALUES (300, 2,
- " 0.134E0, 385.0);" EXECSQLINSERTINTO TIDES.CONSTITUENTS VALUES (300, 2,
0.134E0, 385.0) 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 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 0.0 TO flt1 DISPLAY"SELECT EPOCH INTO :flt1 FROM CONST_RAD" DISPLAY" WHERE LOC_ID = 100" DISPLAY" AND CONST_ID = 0;" EXECSQLSELECT EPOCH INTO :flt1 FROM CONST_RAD WHERE LOC_ID = 100 AND CONST_ID = 0 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"flt1 should be 2.11 += 0.01; its value is ", flt1 if (flt1 < 2.10 OR flt1 > 2.12) then MOVE 0 TO flag END-IF
COMPUTE cnth = -1 DISPLAY"SELECT COUNT(*) INTO :cnth" DISPLAY" FROM CONST_RAD_NOT_NORM" DISPLAY" WHERE EPOCH > 6.2831853E0;" EXECSQLSELECTCOUNT(*) INTO :cnth FROM CONST_RAD_NOT_NORM WHERE EPOCH > 6.2831853E0 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"cnth should be 4; its value is ", cnth if (cnth NOT = 4) then MOVE 0 TO flag END-IF
*Check that constraint. *7PM EST is 12AM GMT, which is outside the constraint
DISPLAY"INSERT INTO PENDING VALUES (" DISPLAY" 101, TIMESTAMP '2025-12-30 19:00:00-05:00'," DISPLAY" TIMESTAMP '2025-12-31 19:00:00-05:00', 1);" EXECSQLINSERTINTO PENDING VALUES (
101, TIMESTAMP '2025-12-30 19:00:00-05:00',
TIMESTAMP '2025-12-31 19:00:00-05:00', 1) 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 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" "
*1993-12-31 19:00:00-05:00 is within the constraint because it's *midnight GMT. Unfortunately, when we cast it to TIDEDATE, *it ends up being just 1993-12-31, which does not meet the *constraint. 6.10 GR.9.c
DISPLAY"SELECT EXTRACT (YEAR FROM CHECK_DATES)" DISPLAY" INTO :cnth" DISPLAY" FROM CHECK_PTS WHERE JOB_ID = 2 AND FLAG = 0;" EXECSQLSELECT EXTRACT (YEAR FROM CHECK_DATES) INTO :cnth FROM CHECK_PTS WHERE JOB_ID = 2 AND FLAG = 0 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 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" "
COMPUTE cnth = -1 DISPLAY"SELECT EXTRACT (YEAR FROM CHECK_DATES)" DISPLAY" INTO :cnth" DISPLAY" FROM CHECK_PTS WHERE JOB_ID = 2 AND FLAG = 1;" EXECSQLSELECT EXTRACT (YEAR FROM CHECK_DATES) INTO :cnth FROM CHECK_PTS WHERE JOB_ID = 2 AND FLAG = 1 END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY"cnth should be 1994; its value is ", cnth if (cnth NOT = 1994) then MOVE 0 TO flag END-IF
DISPLAY"INSERT INTO DINNER_CLUB VALUES" DISPLAY" (0, TIME '17:30:00');" EXECSQLINSERTINTO DINNER_CLUB VALUES
(0, TIME'17:30:00') END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
DISPLAY"INSERT INTO DINNER_CLUB VALUES" DISPLAY" (1, CAST (TIME '18:00:00' AS DINNERTIME));" EXECSQLINSERTINTO DINNER_CLUB VALUES
(1, CAST (TIME'18:00:00' AS DINNERTIME)) END-EXEC MOVESQLCODETO SQL-COD PERFORM CHCKOK DISPLAY" "
DISPLAY"INSERT INTO DINNER_CLUB VALUES" DISPLAY" (2, TIME '19:30:00');" EXECSQLINSERTINTO DINNER_CLUB VALUES
(2, TIME'19:30:00') 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 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" "
EXECSQLCOMMIT WORK END-EXEC MOVESQLCODETO SQL-COD ******************** END TEST0860 ******************** **** 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.27 Sekunden
(vorverarbeitet am 2026-04-25)
¤
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.