| products/Sources/formale Sprachen/COBOL/Test-Suite/SQL P/xop/ |
|
Quellcode-Bibliothek© Kompilation durch diese Firma[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]Datei: xop700.cob Sprache: Cobol |
|
||||||
|
IDENTIFICATION DIVISION.
PROGRAM-ID. XOP700. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. xyz. OBJECT-COMPUTER. xyz. DATA DIVISION. WORKING-STORAGE SECTION. * Embedded SQL COBOL (file "XOP700.PCO") * Copyright 1994, 1995 X/Open Company Limited * All rights reserved. * DISCLAIMER: * This program was reviewed by employees of NIST for * conformance to the SQL standards. * NIST assumes no responsibility for any party's use of * this program. * X/Open and the 'X' symbol are registered trademarks of X/Open Company * Limited in the UK and other countries. ********************************************************* * * COMMENT SECTION * * DATE 1994/04/19 EMBEDDED C LANGUAGE * X/Open SQL VALIDATION TEST SUITE V6.0 * * XOP700.pco * WRITTEN BY: Elaine Pratt * COBOL version modified by Phil Brown * * Tests Defaults and Limits For Data Types * * REFERENCES * X/Open CAE SQL * Section 3.2.2 Data Types * 4.1.3 Data Types and Embedded Host Variables * * <embedded SQL COBOL program> * * DATE PROGRAM LAST CHANGED 2/11/94 * ********************************************************* 01 SQLCODE PIC S9(9) COMP. 01 in254-0. 123456*89012345678901234567890123456789012345678901234567890123456789012 05 in254-1 PIC X(50) VALUE "ohforamuseoffirethatwouldascendthebrightestheaveno". 05 in254-2 PIC X(50) VALUE "finventionakingdomforastageprincestoactandmonarchs". 05 in254-3 PIC X(50) VALUE "tobeholdtheswellingsceneohforamuseoffirethatwoulda". 05 in254-4 PIC X(50) VALUE "scendthebrightestheavenofinventionakingdomforastag". 05 in254-5 PIC X(50) VALUE "eprincestoactandmonarchstobeholdtheswellingsceneth". 05 in254-6 PIC X(4) VALUE "eend". * EXEC SQL BEGIN DECLARE SECTION END-EXEC 01 SQLSTATE PIC X(5). 01 in254 PIC X(254). 01 col1 PIC X(254). 01 int1 PIC S9(10) DISPLAY SIGN LEADING SEPARATE. 01 int2 PIC S9(10) DISPLAY SIGN LEADING SEPARATE. 01 uid PIC X(18). 01 uidx PIC X(18). EXEC SQL END DECLARE SECTION END-EXEC 01 errflg PIC S9(9) DISPLAY SIGN LEADING SEPARATE. 01 errcnt PIC S9(4) DISPLAY SIGN LEADING SEPARATE. *date_time declaration 01 TO-DAY PIC 9(6). 01 THE-TIME PIC 9(8). 01 SQL-COD PIC S9(9) DISPLAY SIGN LEADING SEPARATE. 01 SQL-COD1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE. PROCEDURE DIVISION. P0. MOVE "XOPEN1" TO uid CALL "AUTHID" USING uid MOVE "not logged in, not" TO uidx EXEC SQL SELECT USER INTO :uidx FROM XOPEN1.ECCO END-EXEC MOVE SQLCODE TO SQL-COD if (uid NOT = uidx) then DISPLAY "ERROR: User ", uid " expected. User ", uidx " - " connected" STOP RUN END-IF DISPLAY "X/OPEN Extensions SQL Test Suite, V6.0, Embedded - "COBOL, xop700.pco" DISPLAY "59-byte ID" DISPLAY "TEd Version #" *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 errflg MOVE 0 to errcnt ******************** BEGIN TEST0700 ******************* DISPLAY " TEST0700 " DISPLAY " X/O,DEFAULTS and LIMITS for DATA TYPES " DISPLAY " X/OPEN CAE SQL Sec. 3.2.2 " DISPLAY " - - - - - - - - - - - - - - - - - - - - - " DISPLAY "### INSERT INTO CHAR_TEST VALUES(:in254);" DISPLAY "### INSERT INTO INT_TEST VALUES(-2147483647);" DISPLAY "### INSERT INTO INT_TEST VALUES(2147483647);" DISPLAY "### INSERT INTO SMALL_TEST VALUES(-32767);" DISPLAY "### INSERT INTO SMALL_TEST VALUES(32767);" *Initialise host variables and database table MOVE ALL "FILL" TO col1. MOVE in254-0 to in254. * Clear contents from tables used in this test EXEC SQL DELETE FROM CHAR_TEST END-EXEC EXEC SQL DELETE FROM INT_TEST END-EXEC EXEC SQL DELETE FROM SMALL_TEST END-EXEC. EXEC SQL COMMIT WORK END-EXEC *Checks that a column CHAR(254) can hold a character *string of 254 length * CREATE TABLE CHAR_TEST (COL1 CHAR(254)); EXEC SQL INSERT INTO CHAR_TEST VALUES(:in254) END-EXEC MOVE SQLCODE TO SQL-COD1 EXEC SQL SELECT * INTO :col1 FROM CHAR_TEST END-EXEC MOVE SQLCODE TO SQL-COD if (col1 NOT = in254) then ADD 1 TO errflg DISPLAY "*** Problem found (TEST STEP NUMBER 1) ! *** " DISPLAY "===============================================" DISPLAY "col1 should be (as an unbroken string)" DISPLAY in254-1 DISPLAY in254-2 DISPLAY in254-3 DISPLAY in254-4 DISPLAY in254-5 DISPLAY in254-6 DISPLAY " " DISPLAY "col1 is (as an unbroken string)" MOVE col1 TO in254-0 DISPLAY in254-1 DISPLAY in254-2 DISPLAY in254-3 DISPLAY in254-4 DISPLAY in254-5 DISPLAY in254-6 DISPLAY " " DISPLAY "Status codes on store/retrieve are " SQL-COD1 SQL-COD END-IF * EXEC SQL DELETE FROM CHAR_TEST END-EXEC * MOVE SQLCODE TO SQL-COD DISPLAY "=================================================" *Checks that an INTEGER column can hold a value from *-2147483647 to 2147483647 * * Initialise host variables and database table MOVE 0 TO int1 MOVE 0 TO int2 * EXEC SQL DELETE FROM INT_TEST END-EXEC. * CREATE TABLE INT_TEST (COL1 INTEGER); EXEC SQL INSERT INTO INT_TEST VALUES(-2147483647) END-EXEC MOVE SQLCODE TO SQL-COD EXEC SQL SELECT COL1 INTO :int1 FROM INT_TEST END-EXEC MOVE SQLCODE TO SQL-COD EXEC SQL INSERT INTO INT_TEST VALUES(2147483647) END-EXEC MOVE SQLCODE TO SQL-COD1 EXEC SQL SELECT COL1 INTO :int2 FROM INT_TEST WHERE COL1 >= 2147483647 END-EXEC MOVE SQLCODE TO SQL-COD if (int1 NOT = -2147483647 OR int2 NOT = 2147483647) then DISPLAY "*** Problem found (TEST STEP NUMBER 2) ! *** " ADD 1 TO errflg END-IF DISPLAY "=================================================" DISPLAY "COL1 should be -2147483647, then 2147483647 " DISPLAY "COL1 is ", int1 ", then ", int2 " " DISPLAY "Status on second store/retrieve " SQL-COD1 "/" SQL-COD. *Initialise host variables and database table MOVE 0 TO int1 MOVE 0 TO int2 * EXEC SQL DELETE FROM SMALL_TEST END-EXEC. DISPLAY "=================================================" *Checks that a SMALLINT column can hold a value from *-32767 to 32767 * CREATE TABLE SMALL_TEST (COL1 SMALLINT); EXEC SQL INSERT INTO SMALL_TEST VALUES(-32767) END-EXEC MOVE SQLCODE TO SQL-COD EXEC SQL SELECT COL1 INTO :int1 FROM SMALL_TEST END-EXEC MOVE SQLCODE TO SQL-COD EXEC SQL INSERT INTO SMALL_TEST VALUES(32767) END-EXEC MOVE SQLCODE TO SQL-COD EXEC SQL SELECT COL1 INTO :int2 FROM SMALL_TEST WHERE COL1 > 32766 END-EXEC MOVE SQLCODE TO SQL-COD IF (int1 NOT = -32767 OR int2 NOT = 32767) then DISPLAY "*** Problem found (TEST STEP NUMBER 3) ! *** " ADD 1 TO errflg END-IF DISPLAY "===============================================" DISPLAY "COL1 should be -32767, then 32767 " DISPLAY "COL1 is ", int1 ", then ", int2 " " DISPLAY "===============================================". *Display the number of errors encountered DISPLAY " Number of errors detected is ", errflg " " DISPLAY "### maximum number of errors is 3 ###" IF (errflg = 0) then EXEC SQL INSERT INTO XOPEN1.TESTREPORT VALUES('0700','pass','PCO') END-EXEC MOVE SQLCODE TO SQL-COD DISPLAY " xop700.pco *** pass *** " else EXEC SQL INSERT INTO XOPEN1.TESTREPORT VALUES('0700','fail','PCO') END-EXEC MOVE SQLCODE TO SQL-COD COMPUTE errcnt = errcnt + 1 DISPLAY " xop700.pco *** fail *** " END-IF DISPLAY "=================================================" DISPLAY " " EXEC SQL COMMIT WORK END-EXEC MOVE SQLCODE TO SQL-COD ******************** END TEST0700 ******************* ****** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0 STOP RUN. * **** Procedures for PERFORM statements ¤ Dauer der Verarbeitung: 0.0 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 |
