Quellcode-Bibliothek
© Kompilation durch diese Firma[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]
Datei:
yts763.cob
Sprache: Cobol
IDENTIFICATION DIVISION .PROGRAM-ID . YTS763.ENVIRONMENT DIVISION .CONFIGURATION SECTION .SOURCE-COMPUTER . xyz.OBJECT-COMPUTER . xyz.DATA DIVISION .WORKING-STORAGE SECTION . * EMBEDDED COBOL (file "YTS763.PCO") *Copyright 1996 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 * * YTS763.PCO * WRITTEN BY: Susan Watters * TRANSLATED AUTOMATICALLY FROM EMBEDDED C BY CHRIS SCHANZLE * * <query expression> with INTERSECT CORRESPONDING * * * REFERENCES * 7.10 <query expression> * 7.10 SR.9a * 7.10 SR.10a * 7.10 GR.1b * 7.3 <table expression> * 13.5 <select statement : single row> * 13.1 <declare cursor> * F#30 Table operations * * DATE LAST ALTERED 02.01.96 CTS5 Hand-over Test * * QA Status: Full FC * * Revised by DWF 1996-03-08 * Added rollback after authid * Fixed string lengths * Increased output * Deleted subtest that didn't make sense * Removed EXEC SQL from inside printf **************************************************************** EXEC SQL BEGIN DECLARE SECTION END-EXEC PIC S9(9) COMP .PIC X(5).PIC S9(4) DISPLAY SIGN LEADING SEPARATE .PIC X(20).PIC S9(9) DISPLAY SIGN LEADING SEPARATE .PIC X(15).PIC X(18).PIC X(18).EXEC SQL END DECLARE SECTION END-EXEC PIC S9(9) DISPLAY SIGN LEADING SEPARATE .PIC S9(9) DISPLAY SIGN LEADING SEPARATE .VALUE IS "01234ABCDEFGH56789IJKLMNOPQRSTUVWXYZ" .PIC X OCCURS 36 TIMES.PIC X OCCURS 5 TIMES.PIC S9(9) DISPLAY SIGN LEADING SEPARATE . *date_time declaration PIC 9(6).PIC 9(8).PIC S9(9) DISPLAY SIGN LEADING SEPARATE .PIC S9(9) DISPLAY SIGN LEADING SEPARATE .PIC S9(9) DISPLAY SIGN LEADING SEPARATE .PROCEDURE DIVISION .MOVE "CTS1 " TO uidCALL "AUTHID" USING uidMOVE "not logged in, not" TO uidxEXEC SQL SELECT USER INTO :uidx FROM CTS1.ECCO END-EXEC MOVE SQLCODE TO SQL-CODEXEC SQL ROLLBACK WORK END-EXEC MOVE SQLCODE TO SQL-CODif (uid NOT = uidx) then DISPLAY "ERROR: User " , uid, " expected. User " , uidx, " " connected" STOP RUN END-IF MOVE 0 TO errcntDISPLAY "SQL Test Suite, V6.0, Embedded COBOL, yts763.pco" 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 TEST7518 ******************* MOVE 1 TO flagMOVE 1 TO flag2DISPLAY " TEST7518 " DISPLAY " with INTERSECT " CORRESPONDING" DISPLAY "References:" DISPLAY " 7.10 " DISPLAY " 7.10 SR.9a" DISPLAY " 7.10 SR.10a" DISPLAY " 7.10 GR.1b" DISPLAY " 7.3 "DISPLAY " 13.5 "
DISPLAY " 13.1 "
DISPLAY " F#30 Table operations"
DISPLAY " - - - - - - - - - - - - - - - - - - -"
COMPUTE SQLCODE = -1
MOVE "xxxxx" TO SQLSTATE
*initialise all variables
MOVE 0 TO i
MOVE "zzzzzzzzzzzzzzzzzzzz" TO ename
MOVE "yyyyyyyyyyyyyyy" TO ecit
MOVE 0 TO egrad
*Populate STAFF_CTS2 in such a way that it contains three or mor
*copies of some rows, two copies of some rows and some rows
*that are not duplicated
*For the rows that are not duplicated include some where the
*rows would be duplicates if only the corresponding cols were
*considered
*Populate STAFF_CTS so that, considering only the corresponding
*columns, it contains some rows that are duplicates of rows in
*STAFF_CTS2 and some that are not
*Include cases where the multiplicity of a row in STAFF_CTS is
*less than, equal to and more than the multiplicity of that row
*in STAFF_CTS2
DISPLAY "Check the number of lines in STAFF_CTS2 is
- " correct"
DISPLAY "SELECT COUNT (*) INTO :i FROM STAFF_CTS2;"
EXEC SQL SELECT COUNT (*) INTO :i FROM STAFF_CTS2 END-EXEC
MOVE SQLCODE TO SQL-COD
DISPLAY "i should be 8; its value is ", i
if (i NOT = 8) then
MOVE 0 TO flag
END-IF
*check the number of rows in STAFF_CTS is correct
DISPLAY "Check the number of rows in STAFF_CTS"
DISPLAY "SELECT COUNT (*) INTO :i FROM STAFF_CTS;"
EXEC SQL SELECT COUNT (*) INTO :i FROM STAFF_CTS END-EXEC
MOVE SQLCODE TO SQL-COD
DISPLAY "i should be 5; its value is ", i
if (i NOT = 5) then
MOVE 0 TO flag
END-IF
DISPLAY "INSERT INTO CTS1.ET(col2, col3, col4)"
DISPLAY "SELECT * FROM STAFF_CTS2"
DISPLAY "INTERSECT CORRESPONDING"
DISPLAY "SELECT * FROM STAFF_CTS;"
EXEC SQL INSERT INTO CTS1.ET(col2, col3, col4)
SELECT * FROM STAFF_CTS2
INTERSECT CORRESPONDING
SELECT * FROM STAFF_CTS END-EXEC
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
*Corresponding columns: EMPNAME GRADE CITY
*Betty 10 Vienna
*Carmen 13 Vienna
*Don 12 Deale
*Declare an ordered cursor
DISPLAY "DECLARE data63 CURSOR FOR"
DISPLAY "SELECT col2, col3, col4"
DISPLAY "FROM CTS1.ET"
DISPLAY "ORDER BY col3, col4;"
EXEC SQL DECLARE data63 CURSOR FOR
SELECT col2, col3, col4
FROM CTS1.ET
ORDER BY col3, col4 END-EXEC
DISPLAY "OPEN data63"
EXEC SQL OPEN data63 END-EXEC
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
*retrieve all the rows defined by the cursor
DISPLAY "FETCH data63 INTO :ename, :egrad, :ecit;"
EXEC SQL FETCH data63 INTO :ename, :egrad, :ecit END-EXEC
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "Row expected is 'Betty',10,'Vienna'"
DISPLAY "values returned were ", ename, ", ", egrad, ", ",
ecit
if (ename NOT = "Betty" OR egrad NOT = 10) then
MOVE 0 TO flag2
END-IF
if (ecit NOT = "Vienna") then
MOVE 0 TO flag2
END-IF
DISPLAY "FETCH data63 INTO :ename, :egrad, :ecit;"
EXEC SQL FETCH data63 INTO :ename, :egrad, :ecit END-EXEC
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "Row expected is 'Don',12,'Deale'"
DISPLAY "Values returned were ", ename, ", ", egrad, ", ",
ecit
if (ename NOT = "Don" OR egrad NOT = 12) then
MOVE 0 TO flag2
END-IF
if (ecit NOT = "Deale") then
MOVE 0 TO flag2
END-IF
DISPLAY "FETCH data63 INTO :ename, :egrad, :ecit;"
EXEC SQL FETCH data63 INTO :ename, :egrad, :ecit END-EXEC
MOVE SQLCODE TO SQL-COD
DISPLAY "Row expected is 'Carmen',13,'Vienna'"
DISPLAY "Values returned are ", ename, ", ", egrad, ", ",
ecit
if (ename NOT = "Carmen" OR egrad NOT = 13) then
MOVE 0 TO flag2
END-IF
if (ecit NOT = "Vienna") then
MOVE 0 TO flag2
END-IF
*tell user of FETCH status
if (flag2 = 0) then
DISPLAY "incorrect rows returned - FETCH data63"
MOVE 0 TO flag
END-IF
DISPLAY "CLOSE data63"
EXEC SQL CLOSE data63 END-EXEC
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "ROLLBACK WORK;"
EXEC SQL ROLLBACK WORK END-EXEC
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
if ( flag = 1 ) then
DISPLAY " yts763.pco *** pass *** "
EXEC SQL INSERT INTO CTS1.TESTREPORT
VALUES('7518','pass','PCO') END-EXEC
MOVE SQLCODE TO SQL-COD
else
DISPLAY " yts763.pco *** fail *** "
EXEC SQL INSERT INTO CTS1.TESTREPORT
VALUES('7518','fail','PCO') END-EXEC
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
EXEC SQL COMMIT WORK END-EXEC
MOVE SQLCODE TO SQL-COD
******************** END TEST7518 ********************
**** 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.25 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.
