**************************************************************** * * COMMENT SECTION * * DATE 1996-05-16 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. * * DML181.PCO * WRITTEN BY: David Flater * TRANSLATED AUTOMATICALLY FROM EMBEDDED C BY CHRIS SCHANZLE * * This routine tests Intermediate SQL. * * 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 MOVE SQLCODE TO SQL-COD EXECSQL ROLLBACK WORK END-EXEC MOVE SQLCODE TO 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, dml181.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 TEST0894 ******************* MOVE 1 TO flag
DISPLAY" FIPS sizing TEST0894" DISPLAY" FIPS sizing, length of column lists >= 750" DISPLAY"References:" DISPLAY"FIPS 16.6 -- Sizing #29, Length of UNIQUE columns" DISPLAY"FIPS 16.6 -- Sizing #31, Length of GROUP BY column
- " list" DISPLAY"FIPS 16.6 -- Sizing #33, Length of ORDER BY column
- " list" DISPLAY"FIPS 16.6 -- Sizing #35, Length of FOREIGN KEY
- " column list" DISPLAY"FIPS 16.6 -- Sizing #40, Length of JOIN column
- " list" DISPLAY" FIPS 5.3 -- Format of
- " literal >" DISPLAY" - - - - - - - - - - - - - - - - - - -"
COMPUTE SQLCODE = -1 MOVE"xxxxx"TO SQLSTATE
*746 chars + 4 for the columns = 750 *2 columns, 373 chars each
DISPLAY"DECLARE C0894 CURSOR FOR" DISPLAY" SELECT FIRSTNAME, LASTNAME, AVG(COST)" DISPLAY" FROM PEOPLE_ORDERS" DISPLAY" GROUP BY LASTNAME, FIRSTNAME" DISPLAY" ORDER BY LASTNAME, FIRSTNAME;" EXECSQL DECLARE C0894 CURSOR FOR SELECT FIRSTNAME, LASTNAME, AVG(COST) FROM PEOPLE_ORDERS
GROUP BY LASTNAME, FIRSTNAME ORDERBY LASTNAME, FIRSTNAME END-EXEC
MOVE"xxx"TO naam1 MOVE"xxx"TO naam2 MOVE 0.0 TO flt1 DISPLAY"FETCH C0894 INTO :naam1, :naam2, :flt1;" EXECSQL FETCH C0894 INTO :naam1, :naam2, :flt1 END-EXEC MOVE naam1 TO naam1-st MOVE naam2 TO naam2-st MOVE SQLCODE TO SQL-COD MOVE flt1 TO flt1-disp PERFORM CHCKOK * If the following display aborts, delete it. DISPLAY"naam1 should be 'aaaa...'; its value is ", naam1 MOVE 1 TO int1 PERFORM P50 UNTIL int1 > 373 * If the following display aborts, delete it. DISPLAY"naam2 should be 'bbbb...'; its value is ", naam2 MOVE 1 TO int1 PERFORM P49 UNTIL int1 > 373 DISPLAY "flt1 should be 24.95 +-0.01; its value is ", flt1-disp if (flt1 < 24.94 OR flt1 > 24.96) then MOVE 0 TO flag END-IF
MOVE"xxx"TO naam1 MOVE"xxx"TO naam2 MOVE 0.0 TO flt1 DISPLAY"FETCH C0894 INTO :naam1, :naam2, :flt1;" EXECSQL FETCH C0894 INTO :naam1, :naam2, :flt1 END-EXEC MOVE naam1 TO naam1-st MOVE naam2 TO naam2-st MOVE SQLCODE TO SQL-COD MOVE flt1 TO flt1-disp PERFORM CHCKOK * If the following display aborts, delete it. DISPLAY"naam1 should be 'cccc...'; its value is ", naam1 MOVE 1 TO int1 PERFORM P48 UNTIL int1 > 373 * If the following display aborts, delete it. DISPLAY"naam2 should be 'dddd...'; its value is ", naam2 MOVE 1 TO int1 PERFORM P47 UNTIL int1 > 373 DISPLAY "flt1 should be 9.95 +-0.01; its value is ", flt1-disp if (flt1 < 9.94 OR flt1 > 9.96) then MOVE 0 TO flag END-IF
DISPLAY"COMMIT WORK;" EXECSQL COMMIT WORK END-EXEC MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
DISPLAY"DROP TABLE ORDERS CASCADE;" EXECSQL DROP TABLE ORDERS CASCADE END-EXEC MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
DISPLAY"COMMIT WORK;" EXECSQL COMMIT WORK END-EXEC MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
DISPLAY"DROP TABLE LONG_NAMED_PEOPLE CASCADE;" EXECSQL DROP TABLE LONG_NAMED_PEOPLE CASCADE END-EXEC MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
DISPLAY"COMMIT WORK;" EXECSQL COMMIT WORK END-EXEC MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY" "
if ( flag = 1 ) then DISPLAY" *** pass *** " EXECSQLINSERTINTO HU.TESTREPORT
VALUES('0894','pass','PCO') END-EXEC MOVE SQLCODE TO SQL-COD else DISPLAY" dml181.pco *** fail *** " EXECSQLINSERTINTO HU.TESTREPORT
VALUES('0894','fail','PCO') END-EXEC MOVE SQLCODE TO SQL-COD COMPUTE errcnt = errcnt + 1 END-IF
EXECSQL COMMIT WORK END-EXEC MOVE SQLCODE TO SQL-COD ******************** END TEST0894 ******************** **** 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 (SQLCODE NOT = 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.
P50. if (naam1-s(int1) NOT = 'a') then MOVE 0 TO flag END-IF ADD 1 TO int1
.
P49. if (naam2-s(int1) NOT = 'b') then MOVE 0 TO flag END-IF ADD 1 TO int1
.
P48. if (naam1-s(int1) NOT = 'c') then MOVE 0 TO flag END-IF ADD 1 TO int1
.
P47. if (naam2-s(int1) NOT = 'd') then MOVE 0 TO flag END-IF ADD 1 TO int1
.
¤ Dauer der Verarbeitung: 0.19 Sekunden
(vorverarbeitet)
¤
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 ist noch experimentell.