|
IDENTIFICATION DIVISION.
PROGRAM-ID. DML071.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. xyz.
OBJECT-COMPUTER. xyz.
DATA DIVISION.
WORKING-STORAGE SECTION.
* Embedded SQL COBOL ("DML071.PCO") translated from
* Embedded C on Wed Jan 16 10:18:38 1991.
****************************************************************
*
* COMMENT SECTION
*
* DATE 1989/08/21 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.
*
* DML071.PCO
* WRITTEN BY: SUN DAJUN
*
* THIS ROUTINE TESTS THE WHENEVER CONDITIONS.
*
* REFERENCES
* AMERICAN NATIONAL STANDARD database language - SQL
* X3.168-1989
*
* SECTION 9.2 <embedded exception declaration>
*
****************************************************************
EXEC SQL BEGIN DECLARE SECTION END-EXEC
01 EMPNO1 PIC X(3).
01 SNUM PIC X(3).
01 ind1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 indic1 PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 HOURS1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 i PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 uid PIC X(18).
01 uidx PIC X(18).
EXEC SQL END DECLARE SECTION END-EXEC
01 SQLCODE PIC S9(9) COMP.
01 errcnt PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 cnt PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 cnt2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 SQL-COD PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
* date_time declaration *
01 TO-DAY PIC 9(6).
01 THE-TIME PIC 9(8).
PROCEDURE DIVISION.
P0.
MOVE "HU" TO uid
CALL "AUTHID" USING uid
MOVE "not logged in, not" TO uidx
EXEC SQL SELECT
USER INTO :uidx FROM HU.ECCO END-EXEC
if (uid NOT = uidx) then
DISPLAY "ERROR: User " uid " expected."
DISPLAY "User " uidx " connected."
DISPLAY " "
STOP RUN
END-IF
MOVE 0 TO errcnt
DISPLAY
"SQL Test Suite, V6.0, Embedded COBOL, dml071.pco"
DISPLAY " "
DISPLAY
"59-byte ID"
DISPLAY "TEd Version #"
DISPLAY " "
* date_time print *
ACCEPT TO-DAY FROM DATE
ACCEPT THE-TIME FROM TIME
DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIME
******************** BEGIN TEST0414 *******************
MOVE 0 TO ind1
MOVE 0 TO cnt
MOVE 0 TO cnt2
DISPLAY " TEST0414 "
DISPLAY " WHENEVER NOT FOUND, multiple settings "
DISPLAY "Reference: ANSI X3.168-1989 Section 9.2 General
- " Rules 1) a)"
DISPLAY "Reference: ANSI X3.135-1989 Section 7.3 General
- " Rules 3) a)"
DISPLAY " - - - - - - - - - - - - - - - - - - - - - - -"
DISPLAY "**** If this test lasts too long, stop it and ***"
DISPLAY "**** the result should be FAIL. ***"
EXEC SQL WHENEVER NOT FOUND GOTO P100 END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL DECLARE X CURSOR
FOR SELECT EMPNUM,HOURS
FROM WORKS
WHERE PNUM='P2'
ORDER BY EMPNUM DESC END-EXEC
.
P200.
DISPLAY "At label P200 with cnt=", cnt " and cnt2=", cnt2
COMPUTE cnt = cnt + 1
EXEC SQL OPEN X END-EXEC
MOVE SQLCODE TO SQL-COD
*Fetch past end of cursor:
MOVE 0 TO i
PERFORM P50 UNTIL i > 19
COMPUTE ind1 = -1
DISPLAY "*** should never get here: whenever NOT FOUND
- " failed"
DISPLAY "*** SQLCODE should be 100, it was ", SQL-COD.
GO TO P100.
P50.
EXEC SQL FETCH X INTO :EMPNO1,:HOURS1 END-EXEC
MOVE SQLCODE TO SQL-COD
DISPLAY " EMPNO1=", EMPNO1 " and HOURS1=",
HOURS1 " "
ADD 1 TO i
.
P100.
DISPLAY "At label P100 with cnt=", cnt " and cnt2=", cnt2
EXEC SQL CLOSE X END-EXEC
MOVE SQLCODE TO SQL-COD
if (cnt = 5) then
GO TO P300
END-IF
EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC
MOVE SQLCODE TO SQL-COD
*Empty SELECT. SQLCODE = 100 with no GOTO in effect
EXEC SQL SELECT EMPNUM INTO :EMPNO1 FROM STAFF
WHERE CITY = 'Kensington' END-EXEC
MOVE SQLCODE TO SQL-COD
* Cardinality error. SQLCODE < 0 with no GOTO in effect
EXEC SQL SELECT EMPNUM INTO :EMPNO1 FROM WORKS END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL DECLARE LION CURSOR FOR
SELECT EMPNUM FROM STAFF
WHERE EMPNUM = 'E20' END-EXEC
if (cnt2 > 0) then
EXEC SQL CLOSE LION END-EXEC
MOVE SQLCODE TO SQL-COD
END-IF
EXEC SQL OPEN LION END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL WHENEVER NOT FOUND GO TO P200 END-EXEC
MOVE SQLCODE TO SQL-COD
COMPUTE cnt2 = cnt2 + 1
* FETCH on empty cursor:
EXEC SQL FETCH LION INTO :EMPNO1 END-EXEC
MOVE SQLCODE TO SQL-COD
COMPUTE ind1 = -1
DISPLAY "*** should never get here: whenever NOT FOUND
- " failed"
DISPLAY "*** SQLCODE should be 100, it was ", SQL-COD
.
P300.
DISPLAY "At label P300"
EXEC SQL WHENEVER NOT FOUND GOTO P400 END-EXEC
MOVE SQLCODE TO SQL-COD
* Delete searched not found:
EXEC SQL DELETE FROM WORKS WHERE HOURS = 77 END-EXEC
MOVE SQLCODE TO SQL-COD
COMPUTE ind1 = -1
DISPLAY "*** SQLCODE should be 100, it was ", SQL-COD
DISPLAY "*** should never get here: whenever NOT FOUND
- " failed"
.
P400.
DISPLAY "At label P400"
EXEC SQL WHENEVER NOT FOUND GOTO P500 END-EXEC
MOVE SQLCODE TO SQL-COD
* Update searched not found:
EXEC SQL UPDATE STAFF SET GRADE = 15
WHERE CITY =
(SELECT CITY FROM PROJ
WHERE PNAME = 'SDP' AND PTYPE = 'Test') END-EXEC
MOVE SQLCODE TO SQL-COD
COMPUTE ind1 = -1
DISPLAY "*** should never get here: whenever NOT FOUND
- " failed"
DISPLAY "*** SQLCODE should be 100, it was ", SQL-COD
.
P500.
DISPLAY "At label P500"
EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL ROLLBACK WORK END-EXEC
MOVE SQLCODE TO SQL-COD
if (ind1 = 0 AND cnt = 5 AND cnt2 = 4) then
DISPLAY " *** pass *** "
EXEC SQL INSERT INTO TESTREPORT
VALUES('0414','pass','PCO') END-EXEC
MOVE SQLCODE TO SQL-COD
else
DISPLAY " dml071.pco *** fail *** "
EXEC SQL INSERT INTO TESTREPORT
VALUES('0414','fail','PCO') END-EXEC
ADD 1 TO errcnt
MOVE SQLCODE TO SQL-COD
END-IF
DISPLAY
"===================================================="
EXEC SQL COMMIT WORK END-EXEC
MOVE SQLCODE TO SQL-COD
******************** END TEST0414 *******************
******************** BEGIN TEST0415 *******************
MOVE 0 TO ind1
MOVE 0 TO cnt
MOVE 0 TO cnt2
DISPLAY " TEST0415 "
DISPLAY " WHENEVER SQLERROR, multiple settings "
DISPLAY "Reference: ANSI X3.168-1989 Section 9.2 General
- " Rules 1) b)"
DISPLAY " - - - - - - - - - - - - - - - - - - -"
DISPLAY "**** If this test lasts too long, stop it and ***"
DISPLAY "**** the result should be FAIL."
EXEC SQL WHENEVER SQLERROR GO TO P110 END-EXEC
MOVE SQLCODE TO SQL-COD
.
P130.
DISPLAY "At label P130"
COMPUTE cnt = cnt + 1
*View check constraint error. Column 3 value less than 12.
EXEC SQL INSERT INTO STAFFV2
VALUES('E20', 'John', 2, 'Potomac') END-EXEC
MOVE SQLCODE TO SQL-COD
COMPUTE ind1 = -1
DISPLAY "*** should never get here: whenever SQLERROR
- " failed"
DISPLAY "*** SQLCODE should be <0, it was ", SQL-COD
.
P110.
DISPLAY "At label P110"
if (cnt = 5) then
GO TO P140
END-IF
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL DELETE FROM PROJ1 END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL INSERT INTO PROJ1
SELECT * FROM PROJ END-EXEC
MOVE SQLCODE TO SQL-COD
*Empty SELECT. SQLCODE = 100 with no GOTO in effect
EXEC SQL SELECT EMPNUM INTO :EMPNO1 FROM STAFF
WHERE CITY = 'Kensington' END-EXEC
MOVE SQLCODE TO SQL-COD
* Cardinality error. SQLCODE < 0 with no GOTO in effect
EXEC SQL SELECT EMPNUM INTO :EMPNO1 FROM WORKS END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL WHENEVER SQLERROR GO TO P130 END-EXEC
MOVE SQLCODE TO SQL-COD
COMPUTE cnt2 = cnt2 + 1
* Uniqueness constraint violation. Value 'P1' duplicates.
EXEC SQL INSERT INTO PROJ1
VALUES('P1', 'CA', 'Acro', 20, 'Tibet') END-EXEC
MOVE SQLCODE TO SQL-COD
COMPUTE ind1 = -1
DISPLAY "*** should never get here: whenever SQLERROR
- " failed"
DISPLAY "*** SQLCODE should be <0, it was ", SQL-COD
.
P140.
DISPLAY "At label P140"
EXEC SQL WHENEVER SQLERROR GO TO P120 END-EXEC
MOVE SQLCODE TO SQL-COD
* NOT NULL constraint violation in first column
COMPUTE indic1 = -1
EXEC SQL INSERT INTO STAFF1
VALUES (:EMPNO1 :indic1, 'Ford', 30, 'Tomb') END-EXEC
MOVE SQLCODE TO SQL-COD
COMPUTE ind1 = -1
DISPLAY "*** should never get here: whenever SQLERROR
- " failed"
DISPLAY "*** SQLCODE should be <0, it was ", SQL-COD
.
P120.
DISPLAY "At label P120"
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL ROLLBACK WORK END-EXEC
MOVE SQLCODE TO SQL-COD
if (cnt = 5 AND ind1 = 0 AND cnt2 = 4) then
DISPLAY " *** pass *** "
EXEC SQL INSERT INTO TESTREPORT
VALUES('0415','pass','PCO') END-EXEC
MOVE SQLCODE TO SQL-COD
else
DISPLAY " dml071.pco *** fail *** "
EXEC SQL INSERT INTO TESTREPORT
VALUES('0415','fail','PCO') END-EXEC
ADD 1 TO errcnt
MOVE SQLCODE TO SQL-COD
END-IF
DISPLAY
"===================================================="
EXEC SQL COMMIT WORK END-EXEC
MOVE SQLCODE TO SQL-COD
******************** END TEST0415 *******************
******************** BEGIN TEST0416 *******************
MOVE 0 TO cnt
MOVE 0 TO ind1
DISPLAY " TEST0416 "
DISPLAY " WHENEVER NOTFOUND overlaps WHENEVER SQLERROR
- " "
DISPLAY "Reference: ANSI X3.168-1989 Section 9.2 General
- " Rules 1) c)"
DISPLAY " - - - - - - - - - - - - - - - - - - -"
DISPLAY "**** If this test lasts too long, stop it and the
- " result***"
DISPLAY "**** should be FAIL."
EXEC SQL DECLARE MONKEY CURSOR
FOR SELECT EMPNUM,HOURS
FROM WORKS
WHERE PNUM='P2'
ORDER BY EMPNUM DESC END-EXEC
EXEC SQL WHENEVER SQLERROR GO TO P210 END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL WHENEVER NOT FOUND GOTO P280 END-EXEC
MOVE SQLCODE TO SQL-COD
.
P230.
DISPLAY "At label P230"
COMPUTE cnt = cnt + 1
if (cnt NOT = 1 AND cnt NOT = 3 AND cnt NOT = 8)
then
COMPUTE ind1 = -1
END-IF
*Cardinality error:
EXEC SQL SELECT EMPNUM
INTO :EMPNO1
FROM WORKS
WHERE PNUM='P2' END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC
MOVE SQLCODE TO SQL-COD
.
P240.
DISPLAY "At label P240"
COMPUTE cnt = cnt + 1
if (cnt NOT = 6) then
COMPUTE ind1 = -1
END-IF
EXEC SQL OPEN MONKEY END-EXEC
MOVE SQLCODE TO SQL-COD
* Fetch past end of cursor:
MOVE 0 TO i
PERFORM P49 UNTIL i > 19
COMPUTE ind1 = -1
DISPLAY "*** should never get here: whenever SQLERROR
- " failed"
DISPLAY "*** SQLCODE should be <0, it was ", SQL-COD.
GO TO P210.
P49.
EXEC SQL FETCH MONKEY INTO :EMPNO1,:HOURS1 END-EXEC
MOVE SQLCODE TO SQL-COD
DISPLAY " EMPNO1=", EMPNO1 " and HOURS1=",
HOURS1 " "
ADD 1 TO i
.
P210.
DISPLAY "At label P210"
COMPUTE cnt = cnt + 1
if (cnt = 4) then
GO TO P250
END-IF
if (cnt = 9) then
GO TO P260
END-IF
EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL DELETE FROM PROJ1 END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL INSERT INTO PROJ1
SELECT * FROM PROJ END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL WHENEVER SQLERROR GO TO P230 END-EXEC
MOVE SQLCODE TO SQL-COD
* Uniqueness constraint violation. Value 'P1' duplicates.
if (cnt NOT = 2) then
COMPUTE ind1 = -1
END-IF
EXEC SQL INSERT INTO PROJ1
VALUES('P1', 'CA', 'Acro', 20, 'Tibet') END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC
MOVE SQLCODE TO SQL-COD
.
P250.
DISPLAY "At label P250"
COMPUTE cnt = cnt + 1
if (cnt NOT = 5) then
COMPUTE ind1 = -1
END-IF
EXEC SQL WHENEVER NOT FOUND GOTO P240 END-EXEC
MOVE SQLCODE TO SQL-COD
* Empty SELECT:
EXEC SQL SELECT EMPNUM INTO :EMPNO1 FROM STAFF
WHERE EMPNUM = 'E30' END-EXEC
MOVE SQLCODE TO SQL-COD
.
P280.
DISPLAY "At label P280"
COMPUTE cnt = cnt + 1
if (cnt NOT = 7) then
COMPUTE ind1 = -1
END-IF
EXEC SQL CLOSE MONKEY END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL WHENEVER NOT FOUND GOTO P230 END-EXEC
MOVE SQLCODE TO SQL-COD
* Empty SELECT:
EXEC SQL SELECT EMPNUM INTO :EMPNO1 FROM STAFF
WHERE EMPNUM = 'E30' END-EXEC
MOVE SQLCODE TO SQL-COD
.
P260.
DISPLAY "At label P260"
COMPUTE cnt = cnt + 1
if (cnt NOT = 10) then
COMPUTE ind1 = -1
END-IF
EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL ROLLBACK WORK END-EXEC
MOVE SQLCODE TO SQL-COD
if (ind1 = 0) then
DISPLAY " *** pass *** "
EXEC SQL INSERT INTO TESTREPORT
VALUES('0416','pass','PCO') END-EXEC
MOVE SQLCODE TO SQL-COD
else
DISPLAY " dml071.pco *** fail *** "
EXEC SQL INSERT INTO TESTREPORT
VALUES('0416','fail','PCO') END-EXEC
ADD 1 TO errcnt
MOVE SQLCODE TO SQL-COD
END-IF
DISPLAY
"===================================================="
EXEC SQL COMMIT WORK END-EXEC
MOVE SQLCODE TO SQL-COD
******************** END TEST0416 *******************
**** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0
STOP RUN.
* **** Procedures for PERFORM statements
¤ Dauer der Verarbeitung: 0.24 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.
|
