Quelle xop702.cob Sprache: Cobol

       IDENTIFICATION DIVISION.
       PROGRAM-ID.  XOP702.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SOURCE-COMPUTER.  xyz.
       OBJECT-COMPUTER.  xyz.
       DATA DIVISION.
       WORKING-STORAGE SECTION.

      * Embedded SQL COBOL (file "XOP702.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/03/21 EMBEDDED C LANGUAGE
      * X/Open SQL VALIDATION TEST SUITE V6.0
      *
      * XOP702.PCO
      * WRITTEN BY: Colin O'Driscoll
      *
      * ALTER TABLE ADD COLUMN
      *
      * REFERENCES
      *       X/Open CAE SQL
      *       Section 5.3.2 ALTER TABLE
      *
      *                <embedded SQL C program>
      *
      * DATE PROGRAM LAST CHANGED   2/11/94
      *
      ****************************************************************

           EXEC SQL BEGIN DECLARE SECTION END-EXEC
       01  SQLCODE PIC S9(9) COMP.
       01  SQLSTATE PIC  X(5).
       01  col1 PIC  X(4).
       01  col2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  col3 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  col4 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  errcnt PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
      *date_time declaration
       01  TO-DAY PIC 9(6).
       01  THE-TIME PIC 9(8).
       01  errflg PIC S9(9) DISPLAY SIGN LEADING SEPARATE.

       01  SQL-COD 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
             MOVE 0 TO errcnt
           DISPLAY    "X/OPEN Extensions SQL Test Suite, V6.0, Embedded
      -            "COBOL, xop702.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

      ******************** BEGIN TEST0702 *******************

           DISPLAY " TEST0702 "
           DISPLAY " X/O,ALTER TABLE ADD "
           DISPLAY " X/OPEN CAE SQL Sec. 5.3.2 "
           DISPLAY " - - - - - - - - - - - - - - - - - - -"
           DISPLAY "### INSERT INTO COLUMN_TEST VALUES('BOOK');"
           DISPLAY "### ALTER TABLE COLUMN_TEST ADD COL2 DECIMAL;"
           DISPLAY "### INSERT INTO COLUMN_TEST VALUES('TEST',1);"
           DISPLAY "### ALTER TABLE COLUMN_TEST ADD(COL3 INTEGER,"
           DISPLAY "### COL4 SMALLINT);"
           DISPLAY "### INSERT INTO COLUMN_TEST VALUES('TEST',1,2,3);"
           DISPLAY "### ALTER TABLE COLUMN_TEST ADD COL1 CHAR(4);"
           DISPLAY "================================================="

             MOVE 0 TO errflg
             MOVE " " TO col1
             MOVE 0 TO col2

             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
      *Added for re-test
             EXEC SQL DROP TABLE COLUMN_TEST END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL CREATE TABLE COLUMN_TEST (COL1 CHAR(4)) END-EXEC
             MOVE SQLCODE TO SQL-COD

             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

             EXEC SQL INSERT INTO COLUMN_TEST VALUES('BOOK') END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL SELECT * INTO :col1 FROM COLUMN_TEST END-EXEC
             MOVE SQLCODE TO SQL-COD

             if (col1  NOT  =   "BOOK") then
               DISPLAY "*** Problem found (TEST STEP NUMBER 1) ! *** "
               COMPUTE errflg = errflg + 1
             END-IF
             DISPLAY "================================================="

             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL ALTER TABLE COLUMN_TEST ADD COL2 DECIMAL END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

             EXEC SQL INSERT INTO COLUMN_TEST VALUES('TEST',1) END-EXEC
             MOVE SQLCODE TO SQL-COD

             EXEC SQL SELECT * INTO :col1, :col2 FROM COLUMN_TEST
               WHERE COL2 IS NOT NULL END-EXEC
             MOVE SQLCODE TO SQL-COD

             DISPLAY "col1 should be TEST, col2 should be 1"
             DISPLAY "col1 is ", col1 ", col2 is ", col2

             if (col1  NOT  =   "TEST"  OR  col2  NOT =  1) then
               DISPLAY "*** Problem found (TEST STEP NUMBER 2) ! *** "
               COMPUTE errflg = errflg + 1
             END-IF

             EXEC SQL DELETE FROM COLUMN_TEST END-EXEC
             MOVE SQLCODE TO SQL-COD
             MOVE " " TO col1
             MOVE 0 TO col2 col3 col4
             DISPLAY "================================================="

             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL ALTER TABLE COLUMN_TEST
               ADD(COL3 INTEGER, COL4 SMALLINT) END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

             EXEC SQL INSERT INTO COLUMN_TEST VALUES('TEST',1,2,3)
             END-EXEC
             MOVE SQLCODE TO SQL-COD

             EXEC SQL SELECT * INTO
               :col1,
               :col2,
               :col3,
               :col4
               FROM COLUMN_TEST END-EXEC
             MOVE SQLCODE TO SQL-COD

             DISPLAY "col1 should be TEST, col2 should be 1."
             DISPLAY "col3 should be 2, col4 should be 3."
             DISPLAY "col1 is ", col1 ", col2 is ", col2 "."
             DISPLAY "col3 is ", col3 ", col4 is ", col4

             if (col1  NOT  =   "TEST"  OR  col2  NOT =  1  OR  col3
             NOT =  2  OR  col4  NOT =  3) then
               DISPLAY "*** Problem found (TEST STEP NUMBER 3) ! *** "
               COMPUTE errflg = errflg + 1
             END-IF
             DISPLAY "================================================="

             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL ALTER TABLE COLUMN_TEST ADD COL1 CHAR(4) END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLSTATE should be 'S0021'"
             DISPLAY "SQLSTATE is " SQLSTATE
             if (SQLSTATE  NOT  =   "S0021") then
               DISPLAY "*** Problem found (TEST STEP NUMBER 4) ! *** "
               COMPUTE errflg = errflg + 1
             END-IF
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "================================================="

             DISPLAY "number of errors detected = ", errflg " "
             DISPLAY "### maximum number of errors is 4 ###"

             if (errflg  =  0) then
               EXEC SQL INSERT INTO XOPEN1.TESTREPORT
             VALUES('0702','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
               DISPLAY " xop702.pco *** pass *** "
             else
               EXEC SQL INSERT INTO XOPEN1.TESTREPORT
             VALUES('0702','fail','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
               DISPLAY " xop702.pco *** fail *** "
             END-IF

             EXEC SQL COMMIT WORK END-EXEC
             DISPLAY "================================================="
             DISPLAY  " "

      ******************** END TEST0702 *******************

      ****** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0
           STOP RUN.

      *    ****  Procedures for PERFORM statements

quality100%

¤ Dauer der Verarbeitung: 0.10 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.