| Quellcodebibliothek Statistik Leitseite products/Sources/formale Sprachen/Cobol/Test-Suite/SQL M/ Datei vom 4.1.2008 mit Größe 6 kB |
|
Quelle dml035.cob Sprache: Cobol |
|||||||||
|
IDENTIFICATION DIVISION.
PROGRAM-ID. DML035. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. xyz. OBJECT-COMPUTER. xyz. DATA DIVISION. WORKING-STORAGE SECTION. * Standard COBOL (file "DML035.SCO") calling SQL * procedures in file "DML035.MCO" **************************************************************** * * COMMENT SECTION * * DATE 1987/08/21 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. * * DML035.SCO * WRITTEN BY: HU YANPING * TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE * * THIS ROUTINE TESTS THE DECLARE CURSOR STATEMENT IN THE * LANGUGE OF SQL. THE FORMAT: * DECLARE <cursor name> CURSOR * FOR <cursor specification> * * REFERENCES * AMERICAN NATIONAL STANDARD database language - SQL * X3.135-1989 * * SECTION 8.3 <declare cursor> * **************************************************************** * EXEC SQL BEGIN DECLARE SECTION END-EXEC 01 comp1 COMP-1. * EXEC SQL END DECLARE SECTION END-EXEC 01 i PIC S9(9) DISPLAY SIGN LEADING SEPARATE. 01 ii 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, dml035.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 TEST0157 ******************* MOVE 0 TO i DISPLAY " OPTIONAL TEST0157 " DISPLAY "declare with ORDER BY < sort specification > ... " DISPLAY "reference X3.135-1989 section 8.3 General Rules 3) - " b)" DISPLAY " - - - - - - - - - - - - - - - - - - -" DISPLAY " This test is testing ORDER BY an approximate col." * CREATE TABLE JJ (floattest FLOAT) * EXEC SQL INSERT INTO JJ VALUES(66.2); CALL "SUB1" USING SQLCODE MOVE SQLCODE TO SQL-COD * EXEC SQL INSERT INTO JJ VALUES(-44.5); CALL "SUB2" USING SQLCODE MOVE SQLCODE TO SQL-COD * EXEC SQL INSERT INTO JJ VALUES(0.2222); CALL "SUB3" USING SQLCODE MOVE SQLCODE TO SQL-COD * EXEC SQL INSERT INTO JJ VALUES(66.3); CALL "SUB4" USING SQLCODE MOVE SQLCODE TO SQL-COD * EXEC SQL INSERT INTO JJ VALUES(-87); CALL "SUB5" USING SQLCODE MOVE SQLCODE TO SQL-COD * EXEC SQL INSERT INTO JJ VALUES(-66.25); CALL "SUB6" USING SQLCODE MOVE SQLCODE TO SQL-COD * EXEC SQL DECLARE Z1 CURSOR * FOR SELECT FLOATTEST * FROM JJ * ORDER BY FLOATTEST DESC END-EXEC * EXEC SQL OPEN Z1; CALL "SUB7" USING SQLCODE MOVE SQLCODE TO SQL-COD MOVE 1 TO ii PERFORM P50 UNTIL ii > 14 * EXEC SQL ROLLBACK WORK; CALL "SUB8" USING SQLCODE MOVE SQLCODE TO SQL-COD DISPLAY "The answer should be i = 6; i = ", i " & " DISPLAY " order by comp1 DESC." if (i = 6 AND comp1 < -86) then DISPLAY " *** pass ***" DISPLAY "=====================================================" * EXEC SQL INSERT INTO TESTREPORT * VALUES('0157','pass','MCO') END-EXEC CALL "SUB9" USING SQLCODE MOVE SQLCODE TO SQL-COD else DISPLAY " dml035.sco *** fail ***" DISPLAY "=====================================================" * EXEC SQL INSERT INTO TESTREPORT * VALUES('0157','fail','MCO') END-EXEC ADD 1 TO errcnt CALL "SUB10" USING SQLCODE MOVE SQLCODE TO SQL-COD END-IF DISPLAY " " * EXEC SQL COMMIT WORK; CALL "SUB11" USING SQLCODE MOVE SQLCODE TO SQL-COD ******************** END TEST0157 ******************* **** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0 STOP RUN. * **** Procedures for PERFORM statements P50. * EXEC SQL FETCH Z1 INTO :comp1; CALL "SUB12" USING SQLCODE comp1 MOVE SQLCODE TO SQL-COD if (SQLCODE = 0) then MOVE ii TO i DISPLAY " comp1 = ", comp1 " " END-IF ADD 1 TO ii . ¤ Dauer der Verarbeitung: 0.2 Sekunden (vorverarbeitet) ¤*© Formatika GbR, Deutschland |
|
2026-03-28