| products/sources/formale Sprachen/Cobol/Test-Suite/SQL M/ |
|
Quellcode-Bibliothek© Kompilation durch diese Firma[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]Datei: xts702.cob Sprache: Cobol |
|
||||||
|
IDENTIFICATION DIVISION.
PROGRAM-ID. XTS702. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. xyz. OBJECT-COMPUTER. xyz. DATA DIVISION. WORKING-STORAGE SECTION. * Standard COBOL (file "XTS702.SCO") calling SQL * procedures in file "XTS702.MCO". *Copyright 1995 National Computing Centre Limited *and Computer Logic R&D S.A *on behalf of the CTS5 SQL2 Project. *All rights reserved. *The CTS5 SQL2 Project is sponsored by the European Community. * *The National Computing Centre Limited and Computer Logic R&D *have given permission to NIST to distribute this program *over the World Wide Web in order to promote SQL standards. *DISCLAIMER: *This program was reviewed by employees of NIST for *conformance to the SQL standards. *NIST assumes no responsibility for any party's use of *this program. **************************************************************** * * COMMENT SECTION * * SQL VALIDATION TEST SUITE V6.0 * * XTS702.SCO * WRITTEN BY : Manolis Megaloikonomou * TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE * REVIEWED BY : Nickos Backalidis * * This program tests : * a) LIKE with unrestricted <match value> * b) LIKE with general character value for * pattern and escape * c) LIKE with zero-length escape * *--------------------------------------------------------------- * TEST7007 * * LIKE with unrestricted <match value> * References * 8.5 FT.2 <match value> format * 8.5 SR.1 * 8.5 GR.3 * 8.5 LR.2.a Raising the rule that the match * value shall be a <column reference> * 6.13 FT.5 <character primary> * 6.11 FT.2 <value expression primary> * 6.2 FT.2 <unsigned value specification> * F#28 LIKE enhancements * *--------------------------------------------------------------- * TEST7008 * * LIKE with general char. value for pattern & * escape * References: * 8.5 FT.3 <pattern> format * 8.5 FT.4 <escape character> * 8.5 LR.2.b Raising the rule that the pattern * shall be a <value specification> * 8.5 LR.2.c Raising the rule that the escape * character shall be a <value * specification> * F#28 LIKE enhancements * *--------------------------------------------------------------- * TEST7009 * * LIKE with zero-length escape * References * 8.5 FT.4 <escape character> format * 8.5 GR.3.a.i The length of the string in * <escape character> should be 1 * 8.5 LR.2.c Raising the rule that the escape * character shall be a <value * specification> * 6.7 FT.7 <trim function> * F#28 LIKE enhancements * F#7 TRIM support is required * *--------------------------------------------------------------- * * DATE LAST ALTERED 14/12/95 CTS5 Hand-over Test * * Cleanups and fixes by V. Kogakis 01/12/95: * Initialize ALPNUM * Respect length of strings * Tide up printouts * Modify values inserted in STAFF (test7008) * Modify tests according to test specifications * * QA Status: QA check * *Revised by DWF 1/19/96 * Fixed exceptions * Fixed printout * Fixed check for wrong SQLCODE **************************************************************** * EXEC SQL BEGIN DECLARE SECTION END-EXEC 01 SQLCODE PIC S9(9) COMP. 01 SQLSTATE PIC X(5). 01 uid PIC X(18). 01 uidx PIC X(18). 01 hv2 PIC X(24). 01 coun PIC S9(9) DISPLAY SIGN LEADING SEPARATE. * EXEC SQL END DECLARE SECTION END-EXEC 01 norm1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE. 01 norm2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE. 01 ALPNUM-TABLE VALUE IS "01234ABCDEFGH56789IJKLMNOPQRSTUVWXYZ". 05 ALPNUM PIC X OCCURS 36 TIMES. 01 NORMSQ. 05 NORMSQX PIC X OCCURS 5 TIMES. 01 errcnt PIC S9(9) DISPLAY SIGN LEADING SEPARATE. *date_time declaration 01 TO-DAY PIC 9(6). 01 THE-TIME PIC 9(8). 01 flag PIC S9(9) DISPLAY SIGN LEADING SEPARATE. 01 SQL-COD PIC S9(9) DISPLAY SIGN LEADING SEPARATE. PROCEDURE DIVISION. P0. MOVE "CTS1 " TO uid CALL "AUTHID" USING uid MOVE "not logged in, not" TO uidx * EXEC SQL SELECT USER INTO :uidx FROM CTS1.ECCO; CALL "SUB1" USING SQLCODE SQLSTATE uidx MOVE SQLCODE TO SQL-COD * EXEC SQL ROLLBACK WORK; CALL "SUB2" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD if (uid NOT = uidx) then DISPLAY "ERROR: User ", uid, " expected. User ", uidx, " - " connected" STOP RUN END-IF MOVE 0 TO errcnt DISPLAY "SQL Test Suite, V6.0, Module COBOL, xts702.sco" DISPLAY "59-byte ID" DISPLAY "TEd Version #" *date_time print ACCEPT TO-DAY FROM DATE ACCEPT THE-TIME FROM TIME DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIME ******************** BEGIN TEST7007 ******************* MOVE 1 TO flag DISPLAY " TEST7007 " DISPLAY " LIKE with unrestricted DISPLAY "References:" DISPLAY " 8.5 FT.2 DISPLAY " 8.5 SR.1" DISPLAY " 8.5 GR.3" DISPLAY " 8.5 LR.2.a Raising the rule that the match - " value" DISPLAY " shall be a DISPLAY " 6.13 FT.5 DISPLAY " 6.11 FT.2 DISPLAY " 6.2 FT.2 DISPLAY " F#28 LIKE enhancements" DISPLAY " - - - - - - - - - - - - - - - - - - -" *execute a series of select statements which include *a like predicate *match values should be of types : character literal * character string host variable * USER *Initialise error reporting variables COMPUTE SQLCODE = -1 MOVE "xxxxx" TO SQLSTATE *Subtest 1 MOVE 99 TO coun DISPLAY "SELECT COUNT(*) INTO :coun FROM STAFF" DISPLAY "WHERE 'Alice' LIKE 'Alice';" * EXEC SQL SELECT COUNT(*) * INTO :coun * FROM STAFF * WHERE 'Alice' LIKE 'Alice'; CALL "SUB3" USING SQLCODE SQLSTATE coun MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY "coun should be 5; its value is ", coun if (coun NOT = 5) then MOVE 0 TO flag END-IF DISPLAY " " *Subtest 2 MOVE "Equal_literal" TO hv2 DISPLAY "hv2 = '", hv2, "'" MOVE 99 TO coun DISPLAY "SELECT COUNT(*) INTO :coun FROM STAFF" DISPLAY "WHERE :hv2 NOT LIKE 'Eq_alS_literal%' ESCAPE 'S';" * EXEC SQL SELECT COUNT(*) * INTO :coun * FROM STAFF * WHERE :hv2 NOT LIKE 'Eq_alS_literal%' ESCAPE 'S' * ; CALL "SUB4" USING SQLCODE SQLSTATE coun hv2 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY "coun should be 0; its value is ", coun if (coun NOT = 0) then MOVE 0 TO flag END-IF DISPLAY " " *Subtest 3 MOVE 0 TO coun DISPLAY "SELECT COUNT(*) INTO :coun FROM STAFF" DISPLAY "WHERE USER LIKE 'CTS1%';" * EXEC SQL SELECT COUNT(*) * INTO :coun * FROM STAFF * WHERE USER LIKE 'CTS1%'; CALL "SUB5" USING SQLCODE SQLSTATE coun MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY "coun should be 5; its value is ", coun if (coun NOT = 5) then MOVE 0 TO flag END-IF DISPLAY " " DISPLAY "ROLLBACK WORK;" * EXEC SQL ROLLBACK WORK; CALL "SUB6" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK if ( flag = 1 ) then DISPLAY " xts702.mco *** pass *** " * EXEC SQL INSERT INTO CTS1.TESTREPORT * VALUES('7007','pass','MCO'); CALL "SUB7" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD else DISPLAY " xts702.mco *** fail *** " * EXEC SQL INSERT INTO CTS1.TESTREPORT * VALUES('7007','fail','MCO'); CALL "SUB8" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD COMPUTE errcnt = errcnt + 1 END-IF DISPLAY "========================================" * EXEC SQL COMMIT WORK; CALL "SUB9" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD ******************** END TEST7007 ******************** ******************** BEGIN TEST7008 ****************** MOVE 1 TO flag DISPLAY " TEST7008 " DISPLAY " LIKE with general char. value for pattern & - " escape" DISPLAY "References:" DISPLAY " 8.5 FT.3 DISPLAY " 8.5 FT.4 DISPLAY " 8.5 LR.2.b Raising the rule that the pattern" DISPLAY " shall be a DISPLAY " 8.5 LR.2.c Raising the rule that the escape - " character" DISPLAY " shall be a DISPLAY " F#28 LIKE enhancements" DISPLAY " - - - - - - - - - - - - - - - - - - -" *execute a series of select statements with LIKE *predicates where the match pattern and/or escape *value is a <general character value> *Initialise error reporting variables COMPUTE SQLCODE = -1 MOVE "xxxxx" TO SQLSTATE *Subtest 1 MOVE 0 TO coun DISPLAY "SELECT COUNT(*) INTO :coun FROM STAFF" DISPLAY "WHERE EMPNAME LIKE EMPNAME;" * EXEC SQL SELECT COUNT(*) * INTO :coun * FROM STAFF * WHERE EMPNAME LIKE EMPNAME; CALL "SUB10" USING SQLCODE SQLSTATE coun MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY "coun should be 5; its value is ", coun if (coun NOT = 5) then MOVE 0 TO flag END-IF DISPLAY " " *Subtest 2 DISPLAY "INSERT INTO STAFF" DISPLAY "VALUES('E6','Theodora_FL',14,'T%S_FL%%%%%%%%%');" * EXEC SQL INSERT INTO STAFF * VALUES('E6','Theodora_FL',14,'T%S_FL%%%%%%%%%'); CALL "SUB11" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " MOVE 0 TO coun DISPLAY "SELECT COUNT(*) INTO :coun FROM STAFF WHERE" DISPLAY "EMPNAME LIKE CITY ESCAPE 'S';" * EXEC SQL SELECT COUNT(*) * INTO :coun * FROM STAFF * WHERE EMPNAME LIKE CITY ESCAPE 'S'; CALL "SUB12" USING SQLCODE SQLSTATE coun MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY "coun should be 1; its value is ", coun if (coun NOT = 1) then MOVE 0 TO flag END-IF DISPLAY " " *Subtest 3 DISPLAY "DELETE FROM STAFF;" * EXEC SQL DELETE FROM STAFF; CALL "SUB13" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " DISPLAY "INSERT INTO STAFF" DISPLAY "VALUES('S','Dana%ELFT',14,'D%S%%%%%%%%%%%%');" * EXEC SQL INSERT INTO STAFF * VALUES('S','Dana%ELFT',14,'D%S%%%%%%%%%%%%'); CALL "SUB14" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " MOVE 0 TO coun DISPLAY "SELECT COUNT(*) INTO :coun FROM STAFF WHERE" DISPLAY "EMPNAME LIKE CITY ESCAPE EMPNUM;" * EXEC SQL SELECT COUNT(*) * INTO :coun * FROM STAFF * WHERE EMPNAME LIKE CITY ESCAPE EMPNUM; CALL "SUB15" USING SQLCODE SQLSTATE coun MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY "coun should be 1; its value is ", coun if (coun NOT = 1) then MOVE 0 TO flag END-IF DISPLAY " " *Subtest 4 MOVE 0 TO coun DISPLAY "SELECT COUNT(*) INTO :coun FROM STAFF WHERE" DISPLAY "'Del%' LIKE CITY ESCAPE EMPNUM;" * EXEC SQL SELECT COUNT(*) * INTO :coun * FROM STAFF * WHERE 'Del%' LIKE CITY ESCAPE EMPNUM; CALL "SUB16" USING SQLCODE SQLSTATE coun MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY "coun should be 1; its value is ", coun if (coun NOT = 1) then MOVE 0 TO flag END-IF DISPLAY " " DISPLAY "ROLLBACK WORK;" * EXEC SQL ROLLBACK WORK; CALL "SUB17" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " if ( flag = 1 ) then DISPLAY " xts702.mco *** pass *** " * EXEC SQL INSERT INTO CTS1.TESTREPORT * VALUES('7008','pass','MCO'); CALL "SUB18" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD else DISPLAY " xts702.mco *** fail *** " * EXEC SQL INSERT INTO CTS1.TESTREPORT * VALUES('7008','fail','MCO'); CALL "SUB19" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD COMPUTE errcnt = errcnt + 1 END-IF DISPLAY "========================================" * EXEC SQL COMMIT WORK; CALL "SUB20" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD ******************** END TEST7008 ******************** ******************** BEGIN TEST7009 ******************* MOVE 1 TO flag DISPLAY " TEST7009 " DISPLAY " LIKE with zero-length escape" DISPLAY "References:" DISPLAY " 8.5 FT.4 DISPLAY " 8.5 GR.3.a.i The length of the string in" DISPLAY " DISPLAY " 8.5 LR.2.c Raising the rule that the escape" DISPLAY " character shall be a - " specification>" DISPLAY " 6.7 FT.7 DISPLAY " F#28 LIKE enhancements" DISPLAY " F#7 TRIM support is required" DISPLAY " - - - - - - - - - - - - - - - - - - -" *Initialise error reporting variables COMPUTE SQLCODE = -1 MOVE "xxxxx" TO SQLSTATE *execute a select where the length in characters of the *result of the <character value expression> specified *as the <escape character> in a like predicate is zero *this should not succeed DISPLAY "DELETE FROM STAFF;" * EXEC SQL DELETE FROM STAFF; CALL "SUB21" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " DISPLAY "INSERT INTO STAFF" DISPLAY "VALUES(' ','Dana%ELFT',14,'D%0%%%%%%%%%%%%');" * EXEC SQL INSERT INTO STAFF * VALUES(' ','Dana%ELFT',14,'D%0%%%%%%%%%%%%'); CALL "SUB22" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " *this should not succeed MOVE 10000 TO SQLCODE MOVE "xxxxx" TO SQLSTATE MOVE 99 TO coun DISPLAY "SELECT COUNT(*) INTO :coun FROM STAFF WHERE" DISPLAY "EMPNAME LIKE CITY ESCAPE TRIM(EMPNUM);" * EXEC SQL SELECT COUNT(*) * INTO :coun * FROM STAFF * WHERE EMPNAME LIKE CITY ESCAPE TRIM(EMPNUM); CALL "SUB23" USING SQLCODE SQLSTATE coun MOVE SQLCODE TO SQL-COD DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD DISPLAY "SQLSTATE should be 22019;its value is ", SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (SQLCODE NOT < 0 OR NORMSQ NOT = "22019") then MOVE 0 TO flag END-IF if (NORMSQ = "22019" AND NORMSQ NOT = SQLSTATE) then DISPLAY "Valid implementation-defined SQLSTATE accepted." END-IF DISPLAY " " DISPLAY "ROLLBACK WORK;" * EXEC SQL ROLLBACK WORK; CALL "SUB24" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " if ( flag = 1 ) then DISPLAY " xts702.mco *** pass *** " * EXEC SQL INSERT INTO CTS1.TESTREPORT * VALUES('7009','pass','MCO'); CALL "SUB25" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD else DISPLAY " xts702.mco *** fail *** " * EXEC SQL INSERT INTO CTS1.TESTREPORT * VALUES('7009','fail','MCO'); CALL "SUB26" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD COMPUTE errcnt = errcnt + 1 END-IF DISPLAY "========================================" * EXEC SQL COMMIT WORK; CALL "SUB27" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD ******************** END TEST7009 ******************** **** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0 STOP RUN. * **** 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 PERFORM VARYING 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 GO TO EXIT-NOSUBCLASS END-IF MOVE 4 TO norm1 *examining position 4 of char array NORMSQ *valid characters are 0-9, A-Z PERFORM VARYING 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 PERFORM VARYING 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. ¤ Dauer der Verarbeitung: 0.44 Sekunden (vorverarbeitet) ¤ |
Haftungshinweis
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.Bot Zugriff |
