| Quellcodebibliothek Statistik Leitseite products/Sources/formale Sprachen/Cobol/Test-Suite/SQL M/ Datei vom 4.1.2008 mit Größe 8 kB |
|
SSL dml027.cob Sprache: Cobol |
|||||||||
|
IDENTIFICATION DIVISION.
PROGRAM-ID. DML027. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. xyz. OBJECT-COMPUTER. xyz. DATA DIVISION. WORKING-STORAGE SECTION. * Standard COBOL (file "DML027.SCO") calling SQL * procedures in file "DML027.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. * * DML027.SCO * WRITTEN BY: HU YANPING * TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE * * THIS ROUTINE TESTS THE UPDATE STATEMENT IN THE LANGUAGE OF * SQL. THE FORMAT: * 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 i PIC S9(9) DISPLAY SIGN LEADING SEPARATE. 01 ii PIC S9(9) DISPLAY SIGN LEADING SEPARATE. * EXEC SQL END DECLARE SECTION END-EXEC 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. 01 SQLCODE PIC S9(9) COMP. 01 errcnt PIC S9(4) 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, dml027.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 * 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 TEST0124 ******************* DISPLAY " TEST0124 " DISPLAY " update statement: searched " DISPLAY "reference X3.135-1987 section 8.12 General Rules 1)" DISPLAY " - - - - - - - - - - - - - - - - - - -" *Comment -- This test requires deferred integrity constraint * checking. Some implementations check as they go * along and will likely fail. DISPLAY " *** NUMKEY = {1,2,3,4,6,8} " DISPLAY " *** UPDATE UPUNIQ " DISPLAY " *** SET NUMKEY = NUMKEY+1 " COMPUTE SQLCODE = -1 * EXEC SQL UPDATE UPUNIQ * SET NUMKEY = NUMKEY+1 END-EXEC CALL "SUB1" USING SQLCODE MOVE SQLCODE TO SQL-COD DISPLAY " SQLCODE = ", SQL-COD " " MOVE SQLCODE TO iii * EXEC SQL SELECT COUNT(*),SUM(NUMKEY) * INTO :i,:ii * FROM UPUNIQ END-EXEC CALL "SUB2" USING SQLCODE i ii MOVE SQLCODE TO SQL-COD DISPLAY " There are ", i " records in table UPUNIQ. " DISPLAY " Sum of the colunm NUMKEY is ", ii " " * EXEC SQL ROLLBACK WORK; CALL "SUB3" USING SQLCODE MOVE SQLCODE TO SQL-COD if (i = 6 AND ii = 30 AND iii = 0) then DISPLAY " *** pass *** " * EXEC SQL INSERT INTO TESTREPORT * VALUES('0124','pass','MCO') END-EXEC CALL "SUB4" USING SQLCODE MOVE SQLCODE TO SQL-COD else DISPLAY " dml027.sco *** fail *** " * EXEC SQL INSERT INTO TESTREPORT * VALUES('0124','fail','MCO') END-EXEC ADD 1 TO errcnt CALL "SUB5" USING SQLCODE MOVE SQLCODE TO SQL-COD END-IF DISPLAY "====================================================" * EXEC SQL COMMIT WORK; CALL "SUB6" USING SQLCODE MOVE SQLCODE TO SQL-COD ******************** END TEST0124 ******************* ******************** BEGIN TEST0125 ******************* DISPLAY " TEST0125 " DISPLAY " update statement: searched " DISPLAY "reference X3.135-1987 section 8.12 General Rules 1)" DISPLAY " - - - - - - - - - - - - - - - - - - -" COMPUTE SQLCODE = -1 MOVE 0 TO i MOVE 0 TO ii MOVE 0 TO iii DISPLAY " *** NUMKEY = {1,2,3,4,6,8} " DISPLAY " *** UPDATE UPUNIQ " DISPLAY " *** SET NUMKEY = NUMKEY+1 " DISPLAY " *** WHERE NUMKEY >= 4 " * EXEC SQL UPDATE UPUNIQ * SET NUMKEY = NUMKEY+1 * WHERE NUMKEY >= 4 END-EXEC CALL "SUB7" USING SQLCODE MOVE SQLCODE TO SQL-COD DISPLAY " SQLCODE = ", SQL-COD " " MOVE SQLCODE TO iii * EXEC SQL SELECT COUNT(*),SUM(NUMKEY) * INTO :i,:ii * FROM UPUNIQ END-EXEC CALL "SUB8" USING SQLCODE i ii MOVE SQLCODE TO SQL-COD DISPLAY " There are ", i " records in table UPUNIQ. " DISPLAY " Sum of the colunm NUMKEY is ", ii " " * EXEC SQL ROLLBACK WORK; CALL "SUB9" USING SQLCODE MOVE SQLCODE TO SQL-COD if ( i = 6 AND ii = 27 AND iii = 0 ) then DISPLAY " *** pass *** " * EXEC SQL INSERT INTO TESTREPORT * VALUES('0125','pass','MCO') END-EXEC CALL "SUB10" USING SQLCODE MOVE SQLCODE TO SQL-COD else DISPLAY " dml027.sco *** fail *** " * EXEC SQL INSERT INTO TESTREPORT * VALUES('0125','fail','MCO') END-EXEC ADD 1 TO errcnt CALL "SUB11" USING SQLCODE MOVE SQLCODE TO SQL-COD END-IF DISPLAY "====================================================" * EXEC SQL COMMIT WORK; CALL "SUB12" USING SQLCODE MOVE SQLCODE TO SQL-COD ******************** END TEST0125 ******************* **** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0 STOP RUN. * **** Procedures for PERFORM statements ¤ Dauer der Verarbeitung: 0.21 Sekunden (vorverarbeitet) ¤*© Formatika GbR, Deutschland |
|
2026-03-28