Quelle 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

quality100%

¤ Dauer der Verarbeitung: 0.14 Sekunden (vorverarbeitet) ¤

Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

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.