| products/Sources/formale Sprachen/Cobol/Test-Suite/SQL M/ |
|
Quellcode-Bibliothek© Kompilation durch diese Firma[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]Datei: cob010.cob Sprache: Cobol |
|
||||||
|
IDENTIFICATION DIVISION.
PROGRAM-ID. COB010. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. xyz. OBJECT-COMPUTER. xyz. DATA DIVISION. WORKING-STORAGE SECTION. * STANDARD COBOL (file "COB010.SCO") *************************************************************** * * COMMENT SECTION * * DATE 1993/01/16 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. * * COB010.SCO * WRITTEN BY: Shirley Hurwitz * * THIS ROUTINE TESTS COBOL BINARY DATA TYPE IN SQL LANGUAGE * AS SMALLINT AND INTEGER * * REFERENCES * AMERICAN NATIONAL STANDARD database language - SQL * X3.135-1992 * * SECTION 12.4 Syntax Rule 3) f) and 3) g) * * SECTION 19.5 Syntax Rule 11) * *************************************************************** * EXEC SQL BEGIN DECLARE SECTION END-EXEC 01 var2 PIC S99 USAGE IS BINARY. 01 var6 PIC S9(6) BINARY. 01 var9 PIC S9(9) USAGE BINARY. 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. 01 VAR2-DSPLY PIC S99 DISPLAY SIGN LEADING SEPARATE. 01 VAR6-DSPLY PIC S9(6) DISPLAY SIGN LEADING SEPARATE. 01 VAR9-DSPLY 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; CALL "SUB1" USING SQLCODE uidx 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, Standard COBOL, cob010.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 TEST0535 ******************* DISPLAY " TEST0535" DISPLAY "reference: X3.135-1992 SECTION 12.4 and 19.5" DISPLAY "- - - - - - - - - - - - - - - - - - - - " DISPLAY " " DISPLAY "*** COBOL USAGE IS BINARY;TESTED AS SMALLINT IN SQL" DISPLAY " " DISPLAY "*** CREATE TABLE HH (SMALLTEST SMALLINT) " DISPLAY "*** INSERT INTO HH " DISPLAY "*** VALUES(10) " DISPLAY " " DISPLAY "*** COBOL USAGE IS BINARY;TESTED AS INTEGER IN SQL" DISPLAY " " DISPLAY "*** CREATE TABLE EE (INTTEST INTEGER) " DISPLAY "*** INSERT INTO EE" DISPLAY "*** VALUES(1000000) " DISPLAY " " * EXEC SQL DELETE FROM HH; CALL "SUB2" USING SQLCODE * EXEC SQL INSERT INTO HH * VALUES(10); CALL "SUB3" USING SQLCODE MOVE SQLCODE TO SQL-COD DISPLAY " After First INSERT, SQLCODE = ", SQL-COD " " MOVE 0 TO var2 * EXEC SQL SELECT * * INTO :var2 * FROM HH; CALL "SUB4" USING SQLCODE var2 MOVE SQLCODE TO SQL-COD MOVE var2 TO VAR2-DSPLY DISPLAY " var2 = ", VAR2-DSPLY * EXEC SQL DELETE FROM EE; CALL "SUB5" USING SQLCODE * EXEC SQL INSERT INTO EE * VALUES(100000); CALL "SUB6" USING SQLCODE MOVE SQLCODE TO SQL-COD DISPLAY " After Second INSERT, SQLCODE = ", SQL-COD " " MOVE 0 TO var6 * EXEC SQL SELECT * * INTO :var6 * FROM EE; CALL "SUB7" USING SQLCODE var6 MOVE SQLCODE TO SQL-COD MOVE var6 TO VAR6-DSPLY DISPLAY " var6 = ", VAR6-DSPLY * EXEC SQL ROLLBACK WORK; CALL "SUB8" USING SQLCODE MOVE SQLCODE TO SQL-COD if (var2 = 10 AND var6 = 100000) then DISPLAY " " DISPLAY " *** pass ***" DISPLAY " " * EXEC SQL INSERT INTO TESTREPORT * VALUES('0535','pass','MCO'); CALL "SUB9" USING SQLCODE MOVE SQLCODE TO SQL-COD else DISPLAY " " DISPLAY " cob010.sco *** fail ***" DISPLAY " " * EXEC SQL INSERT INTO TESTREPORT * VALUES('0535','fail','MCO'); CALL "SUB10" USING SQLCODE ADD 1 TO errcnt MOVE SQLCODE TO SQL-COD END-IF DISPLAY "=====================================================" DISPLAY " " * EXEC SQL COMMIT WORK; CALL "SUB11" USING SQLCODE MOVE SQLCODE TO SQL-COD ******************** END TEST0535 ******************* ******************** BEGIN TEST0536 ******************* DISPLAY " TEST0536" DISPLAY "reference: X3.135-1992 SECTION 12.4 and 19.5" DISPLAY "- - - - - - - - - - - - - - - - - - - - " DISPLAY " " DISPLAY "*** FIPS Sizing - COBOL BINARY" DISPLAY "*** Decimal precision >= 9" DISPLAY " " DISPLAY "*** CREATE TABLE EE (INTTEST INTEGER) " DISPLAY "*** INSERT INTO EE " DISPLAY "*** VALUES('100000000') " DISPLAY " " * EXEC SQL DELETE FROM EE; CALL "SUB12" USING SQLCODE * EXEC SQL INSERT INTO EE * VALUES(100000000); CALL "SUB13" USING SQLCODE MOVE SQLCODE TO SQL-COD DISPLAY " After INSERT, SQLCODE = ", SQL-COD " " MOVE 0 TO var9 * EXEC SQL SELECT * * INTO :var9 * FROM EE; CALL "SUB14" USING SQLCODE var9 MOVE SQLCODE TO SQL-COD MOVE var9 TO VAR9-DSPLY DISPLAY " var9 = ", VAR9-DSPLY * EXEC SQL ROLLBACK WORK; CALL "SUB15" USING SQLCODE MOVE SQLCODE TO SQL-COD if (var9 = 100000000) then DISPLAY " " DISPLAY " *** pass ***" DISPLAY " " * EXEC SQL INSERT INTO TESTREPORT * VALUES('0536','pass','MCO'); CALL "SUB16" USING SQLCODE MOVE SQLCODE TO SQL-COD else DISPLAY " " DISPLAY " cob010.sco *** fail ***" DISPLAY " " * EXEC SQL INSERT INTO TESTREPORT * VALUES('0536','fail','MCO'); CALL "SUB17" USING SQLCODE ADD 1 TO errcnt MOVE SQLCODE TO SQL-COD END-IF DISPLAY "=====================================================" DISPLAY " " * EXEC SQL COMMIT WORK; CALL "SUB18" USING SQLCODE MOVE SQLCODE TO SQL-COD ******************** END TEST0536 ******************* **** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0 STOP RUN. ¤ Dauer der Verarbeitung: 0.18 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 |
