Quelle dml058.cob
Sprache: Cobol
IDENTIFICATION DIVISION .
PROGRAM-ID . DML058.
ENVIRONMENT DIVISION .
CONFIGURATION SECTION .
SOURCE-COMPUTER . xyz.
OBJECT-COMPUTER . xyz.
DATA DIVISION .
WORKING-STORAGE SECTION .
* Standard COBOL (file "DML058.SCO") calling SQL
* procedures in file "DML058.MCO"
****************************************************************
*
* COMMENT SECTION
*
* DATE 1988/04/28 STANDARD 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.
*
* DML058.SCO
* WRITTEN BY: SUN DAJUN
* TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE
*
* THIS ROUTINE TESTS THE COMMIT,ROLLBACK AND UPDATE STATEMENT
* IN THE LANGUAGE OF SQL. THE FORMAT:
* COMMIT WORK
*
* ROLLBACK WORK
*
* UPDATE <table name>
* SET <set clause:searched>({,<set clause>}...)
* (WHERE <search condition>)
*
* REFERENCES
* AMERICAN NATIONAL STANDARD database language - SQL
* X3.135-1989
*
* SECTION 6.6 <unique constraint definition>
* SECTION 8.7 <insert statement>
* SECTION 8.10 <select statement>
* SECTION 8.12 <update statement: searched>
*
****************************************************************
* EXEC SQL BEGIN DECLARE SECTION END-EXEC
01 jj PIC S9(9) DISPLAY SIGN LEADING SEPARATE .
01 i PIC S9(9) DISPLAY SIGN LEADING SEPARATE .
01 ii PIC S9(9) DISPLAY SIGN LEADING SEPARATE .
01 city1 PIC X(15).
01 tuser1 PIC X(110).
01 tuser2 PIC X(110).
* EXEC SQL END DECLARE SECTION END-EXEC
01 SQLCODE PIC S9(9) COMP .
01 errcnt PIC S9(4) DISPLAY SIGN LEADING SEPARATE .
01 iii PIC S9(9) DISPLAY SIGN LEADING SEPARATE .
01 uid PIC X(18).
01 uidx PIC X(18).
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
CALL "AUTHCK" USING SQLCODE uidx
MOVE SQLCODE TO SQL-COD
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, Module COBOL, dml058.sco"
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 TEST0251 *******************
DISPLAY " TEST0251 "
DISPLAY " COMMIT WORK "
DISPLAY " reference X3.135-1989 section 8.2 General
- " Rules. 3"
DISPLAY " - - - - - - - - - - - - - - - - - - - - - "
DISPLAY " "
DISPLAY " DELETE FROM STAFF1;"
DISPLAY " "
DISPLAY " INSERT INTO STAFF1"
DISPLAY " SELECT * FROM STAFF;"
DISPLAY " "
DISPLAY " SELECT COUNT(*) INTO :ii"
DISPLAY " FROM STAFF1;"
DISPLAY " "
DISPLAY " INSERT INTO STAFF1"
DISPLAY " VALUES ('E9','Tom',50,'London');"
DISPLAY " "
DISPLAY " UPDATE STAFF1"
DISPLAY " SET GRADE = 40"
DISPLAY " WHERE EMPNUM = 'E2';"
DISPLAY " COMMIT WORK;"
DISPLAY " "
DISPLAY " DELETE FROM STAFF1;"
DISPLAY " ROLLBACK WORK; "
DISPLAY " "
DISPLAY " SELECT COUNT(*) INTO :i"
DISPLAY " FROM STAFF1"
DISPLAY " WHERE GRADE > 12;"
MOVE 0 TO ii
MOVE 0 TO i
* EXEC SQL DELETE FROM STAFF1;
CALL "SUB1" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO STAFF1
* SELECT * FROM STAFF END-EXEC
CALL "SUB2" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT COUNT(*) INTO :ii
* FROM STAFF1 END-EXEC
CALL "SUB3" USING SQLCODE ii
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO STAFF1
* VALUES ('E9','Tom',50,'London') END-EXEC
CALL "SUB4" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL UPDATE STAFF1
* SET GRADE = 40
* WHERE EMPNUM = 'E2' END-EXEC
CALL "SUB5" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL COMMIT WORK;
CALL "SUB6" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL DELETE FROM STAFF1;
CALL "SUB7" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL ROLLBACK WORK;
CALL "SUB8" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT COUNT(*) INTO :i
* FROM STAFF1
* WHERE GRADE > 12 END-EXEC
CALL "SUB9" USING SQLCODE i
MOVE SQLCODE TO SQL-COD
* EXEC SQL DELETE FROM STAFF1;
CALL "SUB10" USING SQLCODE
MOVE SQLCODE TO SQL-COD
DISPLAY " The correct answer is :"
DISPLAY " ii is 5"
DISPLAY " i is 4"
DISPLAY " Your answer is :"
DISPLAY " ii is " , ii
DISPLAY " i is " , i
if (ii = 5 AND i = 4) then
* EXEC SQL INSERT INTO TESTREPORT
* VALUES('0251','pass','MCO') END-EXEC
CALL "SUB11" USING SQLCODE
MOVE SQLCODE TO SQL-COD
DISPLAY " *** pass *** "
else
* EXEC SQL INSERT INTO TESTREPORT
* VALUES('0251','fail','MCO') END-EXEC
ADD 1 TO errcnt
CALL "SUB12" USING SQLCODE
MOVE SQLCODE TO SQL-COD
DISPLAY " dml058.sco *** fail *** "
END-IF
DISPLAY "================================================"
DISPLAY " "
* EXEC SQL COMMIT WORK;
CALL "SUB13" USING SQLCODE
MOVE SQLCODE TO SQL-COD
**************** END TEST 0251 **********
******************** BEGIN TEST0252 *******************
DISPLAY " TEST0252 "
DISPLAY " ROLLBACK WORK "
DISPLAY " reference X3.135-1989 section 8.9 Gerneral
- " Rules 1"
DISPLAY " - - - - - - - - - - - - - - - - - - - - - "
DISPLAY " "
DISPLAY " DELETE FROM STAFF1;"
DISPLAY " "
DISPLAY " INSERT INTO STAFF1"
DISPLAY " SELECT * FROM STAFF;"
DISPLAY " COMMIT WORK;"
DISPLAY " "
DISPLAY " UPDATE STAFF1"
DISPLAY " SET EMPNUM = 'E9'"
DISPLAY " WHERE EMPNUM = 'E1';"
DISPLAY " "
DISPLAY " ROLLBACK WORK;"
DISPLAY " "
DISPLAY " SELECT COUNT(*) INTO :i"
DISPLAY " FROM STAFF1"
DISPLAY " WHERE EMPNUM = 'E1';"
MOVE 0 TO i
* EXEC SQL DELETE FROM STAFF1;
CALL "SUB14" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO STAFF1
* SELECT * FROM STAFF END-EXEC
CALL "SUB15" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL COMMIT WORK;
CALL "SUB16" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO STAFF1
* VALUES ('E10','Tom',50,'London') END-EXEC
CALL "SUB17" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL UPDATE STAFF1
* SET GRADE = 40
* WHERE EMPNUM = 'E1' END-EXEC
CALL "SUB18" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL DELETE FROM STAFF1
* WHERE EMPNUM = 'E2' END-EXEC
CALL "SUB19" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL ROLLBACK WORK;
CALL "SUB20" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT SUM(GRADE) INTO :i
* FROM STAFF1 END-EXEC
CALL "SUB21" USING SQLCODE i
MOVE SQLCODE TO SQL-COD
* EXEC SQL DELETE FROM STAFF1;
CALL "SUB22" USING SQLCODE
MOVE SQLCODE TO SQL-COD
DISPLAY " The correct answer is :"
DISPLAY " i is 60"
DISPLAY " Your answer is :"
DISPLAY " i is " , i
if (i = 60) then
* EXEC SQL INSERT INTO TESTREPORT
* VALUES('0252','pass','MCO') END-EXEC
CALL "SUB23" USING SQLCODE
MOVE SQLCODE TO SQL-COD
DISPLAY " *** pass *** "
else
* EXEC SQL INSERT INTO TESTREPORT
* VALUES('0252','fail','MCO') END-EXEC
ADD 1 TO errcnt
CALL "SUB24" USING SQLCODE
MOVE SQLCODE TO SQL-COD
DISPLAY " dml058.sco *** fail *** "
END-IF
DISPLAY "================================================"
DISPLAY " "
* EXEC SQL COMMIT WORK;
CALL "SUB25" USING SQLCODE
MOVE SQLCODE TO SQL-COD
**************** END TEST 0252 **********
* EXEC SQL CREATE TABLE UPUNIQ (NUMKEY DECIMAL(3) UNIQUE,
* COL2 CHAR(2));
* See INSERTs in program BASETAB.SCO
* INSERT INTO UPUNIQ VALUES(1,'A')
* INSERT INTO UPUNIQ VALUES(2,'B')
* INSERT INTO UPUNIQ VALUES(3,'C')
* INSERT INTO UPUNIQ VALUES(4,'D')
* INSERT INTO UPUNIQ VALUES(6,'F')
* INSERT INTO UPUNIQ VALUES(8,'H')
******************** BEGIN TEST0253 *******************
DISPLAY " TEST0253 "
DISPLAY " update (key=key+1) workaround "
DISPLAY " reference X3.135-1989 section 8.12, 6.6 GR. 2)"
DISPLAY " - - - - - - - - - - - - - - - - - - -"
*Comment -- This test does not requires deferred integrity
* constraint checking, but has the same effect as
* SET NUMKEY = NUMKEY + 1
DISPLAY " "
DISPLAY " DECLARE SUN CURSOR "
DISPLAY " FOR SELECT NUMKEY FROM UPUNIQ"
DISPLAY " ORDER BY NUMKEY DESC;"
DISPLAY " "
DISPLAY " FETCH SUN INTO :jj;"
DISPLAY " "
DISPLAY " UPDATE UPUNIQ"
DISPLAY " SET NUMKEY = :jj + 1 "
DISPLAY " WHERE NUMKEY = :jj;"
DISPLAY " "
* EXEC SQL DECLARE SUN CURSOR
* FOR SELECT NUMKEY FROM UPUNIQ
* ORDER BY NUMKEY DESC END-EXEC
* EXEC SQL OPEN SUN;
CALL "SUB26" USING SQLCODE
MOVE SQLCODE TO SQL-COD
MOVE 0 TO i
PERFORM P50 UNTIL i > 9
* EXEC SQL CLOSE SUN;
CALL "SUB27" USING SQLCODE
MOVE SQLCODE TO SQL-COD
MOVE 0 TO i
MOVE 0 TO ii
* EXEC SQL SELECT MAX(NUMKEY), MIN(NUMKEY)
* INTO :i,:ii
* FROM UPUNIQ END-EXEC
CALL "SUB28" USING SQLCODE i ii
MOVE SQLCODE TO SQL-COD
DISPLAY " The max numkey in table UPUNIQ is " , i ". "
DISPLAY " The min numkey in table UPUNIQ is " , ii ". "
* EXEC SQL ROLLBACK WORK;
CALL "SUB29" USING SQLCODE
MOVE SQLCODE TO SQL-COD
if (i = 9 AND ii = 2) then
DISPLAY " *** pass *** "
* EXEC SQL INSERT INTO TESTREPORT
* VALUES('0253','pass','MCO') END-EXEC
CALL "SUB30" USING SQLCODE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " dml058.sco *** fail *** "
* EXEC SQL INSERT INTO TESTREPORT
* VALUES('0253','fail','MCO') END-EXEC
ADD 1 TO errcnt
CALL "SUB31" USING SQLCODE
MOVE SQLCODE TO SQL-COD
END-IF
DISPLAY
"===================================================="
* EXEC SQL COMMIT WORK;
CALL "SUB32" USING SQLCODE
MOVE SQLCODE TO SQL-COD
******************** END TEST0253 *******************
******************** BEGIN TEST0254 *******************
DISPLAY " TEST0254 "
DISPLAY " UPDATE -COLUMN SPEC. "
DISPLAY " reference X3.135-1989 section 8.12, 5.9"
DISPLAY " - - - - - - - - - - - - - - - - - - - - - "
DISPLAY " "
DISPLAY " UPDATE PROJ1"
DISPLAY " SET CITY = PTYPE;"
DISPLAY " "
DISPLAY " SELECT CITY INTO :city1"
DISPLAY " FROM PROJ1"
DISPLAY " WHERE PNUM = 'P1';"
COMPUTE iii = -1
MOVE "NV" TO city1
* EXEC SQL DELETE FROM PROJ1;
CALL "SUB33" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO PROJ1
* SELECT * FROM PROJ END-EXEC
CALL "SUB34" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL UPDATE PROJ1
* SET CITY = PTYPE END-EXEC
CALL "SUB35" USING SQLCODE
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO iii
* EXEC SQL SELECT CITY INTO :city1
* FROM PROJ1
* WHERE PNUM = 'P1' END-EXEC
CALL "SUB36" USING SQLCODE city1
MOVE SQLCODE TO SQL-COD
* EXEC SQL ROLLBACK WORK;
CALL "SUB37" USING SQLCODE
MOVE SQLCODE TO SQL-COD
DISPLAY " The correct answer is :"
DISPLAY " iii is 0"
DISPLAY " city1 = Design"
DISPLAY " Your answer is :"
DISPLAY " iii is " , iii
DISPLAY " city1 = " , city1
if (city1 = "Design" AND iii = 0) then
* EXEC SQL INSERT INTO TESTREPORT
* VALUES('0254','pass','MCO') END-EXEC
CALL "SUB38" USING SQLCODE
MOVE SQLCODE TO SQL-COD
DISPLAY " *** pass *** "
else
* EXEC SQL INSERT INTO TESTREPORT
* VALUES('0254','fail','MCO') END-EXEC
ADD 1 TO errcnt
CALL "SUB39" USING SQLCODE
MOVE SQLCODE TO SQL-COD
DISPLAY " dml058.sco *** fail *** "
END-IF
DISPLAY "================================================"
DISPLAY " "
* EXEC SQL COMMIT WORK;
CALL "SUB40" USING SQLCODE
MOVE SQLCODE TO SQL-COD
**************** END TEST 0254 **********
******************** BEGIN TEST0255 *******************
*For INSERT, UPDATE
DISPLAY " TEST0255 "
DISPLAY " USER <value specification>. "
DISPLAY " reference X3.135-1989 section 8.7,8.12 & 5.6"
DISPLAY " - - - - - - - - - - - - - - - - - - - - - "
DISPLAY " "
DISPLAY " "
DISPLAY " INSERT INTO T4"
DISPLAY " VALUES (USER,100,'good','luck');"
DISPLAY " "
DISPLAY " SELECT STR110 INTO :tuser1 FROM T4"
DISPLAY " WHERE NUM6 = 100;"
DISPLAY " "
DISPLAY " INSERT INTO T4"
DISPLAY " VALUES ('Hello',101,'good','luck');"
DISPLAY " "
DISPLAY " UPDATE T4"
DISPLAY " SET STR110 = USER"
DISPLAY " WHERE NUM6 = 101;"
DISPLAY " "
DISPLAY " SELECT STR110 INTO :tuser2 FROM T4"
DISPLAY " WHERE NUM6 = 101;"
* EXEC SQL DELETE FROM T4;
CALL "SUB41" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO T4
* VALUES (USER,100,'good','luck') END-EXEC
CALL "SUB42" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT STR110 INTO :tuser1 FROM T4
* WHERE NUM6 = 100 END-EXEC
CALL "SUB43" USING SQLCODE tuser1
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO T4
* VALUES ('Hello',101,'good','luck') END-EXEC
CALL "SUB44" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL UPDATE T4
* SET STR110 = USER
* WHERE NUM6 = 101 END-EXEC
CALL "SUB45" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT STR110 INTO :tuser2 FROM T4
* WHERE NUM6 = 101 END-EXEC
CALL "SUB46" USING SQLCODE tuser2
MOVE SQLCODE TO SQL-COD
DISPLAY " The correct answer is :"
DISPLAY " tuser1 = HU"
DISPLAY " tuser2 = HU"
DISPLAY " Your answer is :"
DISPLAY " tuser1 = " , tuser1
DISPLAY " tuser2 = " , tuser2
* EXEC SQL ROLLBACK WORK;
CALL "SUB47" USING SQLCODE
MOVE SQLCODE TO SQL-COD
if (tuser1 = "HU" AND tuser2 = "HU" ) then
* EXEC SQL INSERT INTO TESTREPORT
* VALUES('0255','pass','MCO') END-EXEC
CALL "SUB48" USING SQLCODE
MOVE SQLCODE TO SQL-COD
DISPLAY " *** pass *** "
else
* EXEC SQL INSERT INTO TESTREPORT
* VALUES('0255','fail','MCO') END-EXEC
ADD 1 TO errcnt
CALL "SUB49" USING SQLCODE
MOVE SQLCODE TO SQL-COD
DISPLAY " dml058.sco *** fail *** "
END-IF
DISPLAY "================================================"
DISPLAY " "
* EXEC SQL COMMIT WORK;
CALL "SUB50" USING SQLCODE
MOVE SQLCODE TO SQL-COD
**************** END TEST 0255 **********
******************** BEGIN TEST0256 *******************
*For WHERE
DISPLAY " TEST0256 "
DISPLAY " USER in WHERE clause. "
DISPLAY " reference X3.135-1989 section 8.7,8.12 "
DISPLAY " - - - - - - - - - - - - - - - - - - - - - "
DISPLAY " "
DISPLAY " INSERT INTO T4"
DISPLAY " VALUES ('HU',100,'good','luck');"
DISPLAY " "
DISPLAY " SELECT STR110 INTO :tuser1 FROM T4"
DISPLAY " WHERE STR110 = USER;"
DISPLAY " "
DISPLAY " INSERT INTO T4"
DISPLAY " VALUES ('Hello',101,'good','luck');"
DISPLAY " "
DISPLAY " DELETE FROM T4"
DISPLAY " WHERE STR110 = USER;"
DISPLAY " "
DISPLAY " SELECT COUNT(*) INTO :ii FROM T4"
DISPLAY " WHERE STR110 LIKE '%U%;"
COMPUTE ii = -1
* EXEC SQL DELETE FROM T4;
CALL "SUB51" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO T4
* VALUES ('HU',100,'good','luck') END-EXEC
CALL "SUB52" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT STR110 INTO :tuser1 FROM T4
* WHERE STR110 = USER END-EXEC
CALL "SUB53" USING SQLCODE tuser1
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO T4
* VALUES ('Hello',101,'good','luck') END-EXEC
CALL "SUB54" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL DELETE FROM T4
* WHERE STR110 = USER END-EXEC
CALL "SUB55" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT COUNT(*) INTO :ii FROM T4
* WHERE STR110 LIKE '%HU%' END-EXEC
CALL "SUB56" USING SQLCODE ii
MOVE SQLCODE TO SQL-COD
DISPLAY " The correct answer is :"
DISPLAY " tuser1 = HU"
DISPLAY " ii = 0"
DISPLAY " Your answer is :"
DISPLAY " tuser1 = " , tuser1
DISPLAY " ii = " , ii
* EXEC SQL ROLLBACK WORK;
CALL "SUB57" USING SQLCODE
MOVE SQLCODE TO SQL-COD
if (tuser1 = "HU" AND ii = 0) then
* EXEC SQL INSERT INTO TESTREPORT
* VALUES('0256','pass','MCO') END-EXEC
CALL "SUB58" USING SQLCODE
MOVE SQLCODE TO SQL-COD
DISPLAY " *** pass *** "
else
* EXEC SQL INSERT INTO TESTREPORT
* VALUES('0256','fail','MCO') END-EXEC
ADD 1 TO errcnt
CALL "SUB59" USING SQLCODE
MOVE SQLCODE TO SQL-COD
DISPLAY " dml058.sco *** fail *** "
END-IF
DISPLAY "================================================"
DISPLAY " "
* EXEC SQL COMMIT WORK;
CALL "SUB60" USING SQLCODE
MOVE SQLCODE TO SQL-COD
**************** END TEST 0256 **********
**** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0
STOP RUN .
* **** Procedures for PERFORM statements
P50.
* EXEC SQL FETCH SUN INTO :jj;
CALL "SUB61" USING SQLCODE jj
MOVE SQLCODE TO SQL-COD
* EXEC SQL UPDATE UPUNIQ
* SET NUMKEY = :jj + 1
* WHERE NUMKEY = :jj END-EXEC
CALL "SUB62" USING SQLCODE jj
MOVE SQLCODE TO SQL-COD
ADD 1 TO i
.
Messung V0.5 in Prozent C=81 H=99 G=90
¤ Dauer der Verarbeitung: 0.16 Sekunden
(vorverarbeitet am 2026-05-06)
¤
*© Formatika GbR, Deutschland
2026-05-26