| products/Sources/formale Sprachen/Cobol/Test-Suite/SQL P/dml1-99/ |
|
Quellcode-Bibliothek© Kompilation durch diese Firma[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]Datei: dml017.cob Sprache: Cobol |
|
||||||
|
IDENTIFICATION DIVISION.
PROGRAM-ID. DML017. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. xyz. OBJECT-COMPUTER. xyz. DATA DIVISION. WORKING-STORAGE SECTION. * EMBEDDED COBOL (file "DML017.PCO") **************************************************************** * * COMMENT SECTION * * DATE 1987/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. * * DML017.PCO * WRITTEN BY: HU YANPING * TRANSLATED AUTOMATICALLY FROM EMBEDDED C BY CHRIS SCHANZLE * * THIS ROUTINE TESTS THE WHENEVER CONDITIONS. * * REFERENCES * AMERICAN NATIONAL STANDARD database language - SQL * X3.135-1989 * * SECTION Annexes B. <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 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 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, dml017.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 MOVE 0 TO ind1 ******************** BEGIN TEST0067 ******************* EXEC SQL WHENEVER NOT FOUND GOTO P100 END-EXEC MOVE SQLCODE TO SQL-COD *Do legit select that won't find anything DISPLAY " TEST0067 " DISPLAY " DISPLAY "Reference: ANSI X3.135-1989 Annexes B. General - " Rules" DISPLAY " - - - - - - - - - - - - - - - - - - - - - - -" EXEC SQL DECLARE X CURSOR FOR SELECT EMPNUM,HOURS FROM WORKS WHERE PNUM='P2' ORDER BY EMPNUM DESC END-EXEC EXEC SQL OPEN X END-EXEC MOVE SQLCODE TO SQL-COD MOVE 0 TO i PERFORM P50 UNTIL i > 19 COMPUTE ind1 = -1 DISPLAY "*** should never get here: whenever notfound - " failed" DISPLAY "*** SQLCODE should be 100, it was ", SQL-COD . GO TO P100. * **** Procedures for PERFORM statements 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. EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC MOVE SQLCODE TO SQL-COD EXEC SQL CLOSE X END-EXEC MOVE SQLCODE TO SQL-COD EXEC SQL SELECT EMPNUM INTO :SNUM FROM STAFF WHERE EMPNUM='E8' END-EXEC MOVE SQLCODE TO SQL-COD DISPLAY " SQLCODE should be 100: SQLCODE = ", SQL-COD if (SQLCODE NOT = 100) then DISPLAY " SQLCODE is wrong !!!" END-IF if (ind1 = 0 ) then DISPLAY " *** pass *** " EXEC SQL INSERT INTO TESTREPORT VALUES('0067','pass','PCO') END-EXEC MOVE SQLCODE TO SQL-COD else DISPLAY " dml017.pco *** fail *** " EXEC SQL INSERT INTO TESTREPORT VALUES('0067','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 TEST0067 ******************* ******************** BEGIN TEST0068 ******************* EXEC SQL WHENEVER SQLERROR GO TO P110 END-EXEC MOVE SQLCODE TO SQL-COD DISPLAY " TEST0068 " DISPLAY " DISPLAY "Reference: ANSI X3.135-1989 Annexes B. General - " Rules" DISPLAY " - - - - - - - - - - - - - - - - - - -" MOVE 0 TO ind1 *select more than one row. that should get an error EXEC SQL SELECT EMPNUM INTO :EMPNO1 FROM WORKS WHERE PNUM='P2' 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. *open a cursor twice. that should get an error EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC MOVE SQLCODE TO SQL-COD EXEC SQL DECLARE XX CURSOR FOR SELECT * FROM PROJ END-EXEC EXEC SQL OPEN XX END-EXEC MOVE SQLCODE TO SQL-COD EXEC SQL OPEN XX END-EXEC MOVE SQLCODE TO SQL-COD DISPLAY "SQLCODE should < 0, SQLCODE = ", SQL-COD " " if (SQLCODE NOT < 0) then DISPLAY " SQLCODE is wrong !!!" END-IF if (ind1 = 0 ) then DISPLAY " *** pass *** " EXEC SQL INSERT INTO TESTREPORT VALUES('0068','pass','PCO') END-EXEC MOVE SQLCODE TO SQL-COD else DISPLAY " dml017.pco *** fail *** " EXEC SQL INSERT INTO TESTREPORT VALUES('0068','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 TEST0068 ******************* **** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0 STOP RUN. ¤ Dauer der Verarbeitung: 0.19 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 |
