Quelle xop712.cob Sprache: Cobol

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

      * Embedded SQL COBOL (file "XOP712.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/06/21 EMBEDDED COBOL LANGUAGE
      * X/Open SQL VALIDATION TEST SUITE V6.0
      *
      * XOP712.PCO
      * WRITTEN BY: Phil Brown
      * Exists only in Embedded COBOL version
      *
      *    This program tests the data type mapping for COBOL data
      *    types S9(m)V9(n) onto SQL data types DECIMAL(m+n,n)
      *    and COMP-3 onto SQL data types SMALLINT, INT and DECIMAL
      *
      * REFERENCES
      *      International Standard 9075:1992, Database language SQL
      *
      *            Sub-clause 6.1, <data type>
      *            Sub-clause 19.5, <embedded SQL COBOL program>

      *      X/Open CAE Specification C201,
      *                  Structured Query Language (SQL)

      *         Section 4.1.3, Data Types and embedded Host variables

      *         DATE LAST CHANGED  1/11/94
      *
      ****************************************************************

           EXEC SQL BEGIN DECLARE SECTION END-EXEC
       01  s903   PIC S999 DISPLAY SIGN LEADING SEPARATE.
       01  s9v914 PIC S9V9(14) DISPLAY SIGN LEADING SEPARATE.
       01  s915   PIC S9(15) DISPLAY SIGN LEADING SEPARATE.
       01  sv915  PIC SV9(15) DISPLAY SIGN LEADING SEPARATE.

       01  s95c3    PIC S99999   COMP-3.
       01  s9v914c3 PIC S9V9(14) COMP-3.
       01  s910c3   PIC S9(10)   COMP-3.
       01  sv915c3  PIC SV9(15)  COMP-3.

       01  uid PIC X(18).
       01  uidx PIC X(18).

       77  SQLSTATE PIC X(5).
       77  SQLCODE  PIC S9(9) COMP.
           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  erracc PIC S9(9) DISPLAY SIGN LEADING SEPARATE.

       77  SQLCOD  PIC S9(9) DISPLAY SIGN LEADING SEPARATE.

       01  s95d     PIC S99999   DISPLAY SIGN LEADING SEPARATE.
       01  s9v914d  PIC S9V9(14) DISPLAY SIGN LEADING SEPARATE.
       01  s910d    PIC S9(10)   DISPLAY SIGN LEADING SEPARATE.
       01  sV915d   PIC SV9(15)  DISPLAY SIGN LEADING SEPARATE.

      *variables for nosubclass routine

       01  norm1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  norm2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  flag PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
       01  ALPNUM VALUE IS
            "01234ABCDEFGH5678IJKLMNOPQRSTUVWXYZ".
            05 ALPNUM3 PIC X OCCURS 36 TIMES.
       01  SQLSTORE PIC X(5).
       01  SQLS2 REDEFINES SQLSTORE.
            05 NORMSQ PIC X OCCURS 5 TIMES.
       01  NORMSQ2 PIC  X(5).


       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
           if (uid NOT = uidx) then
             DISPLAY "ERROR: User " uid " expected."
             DISPLAY "User " uidx " connected."
             STOP RUN
           END-IF

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

      ******************** BEGIN TEST0712 *******************

           DISPLAY " TEST0712"
            DISPLAY "X/O,MAPPING OF DATATYPES ONTO SQL DECIMAL"
           DISPLAY "references: ISO/IEC 9075:1992 6.1 & 19.5"
           DISPLAY " X/Open C201:1992 4.1.3"
           DISPLAY " - - - - - - - - - - - - - - - - - - -"
            DISPLAY " "
           DISPLAY " *** CREATE TABLE TV (dec3 DECIMAL(3)"
           DISPLAY " dec1514 DECIMAL(15,14)"
           DISPLAY " dec150 DECIMAL(15,0)"
           DISPLAY " dec1515 DECIMAL(15,15)) "
            DISPLAY " "
           DISPLAY " *** INSERT INTO TV VALUES"
           DISPLAY
           "(456, 0.12345678912345, 543210987654321, .123456789012345)"
           DISPLAY
           "(999, 9.99999999999999, 999999999999999, .999999999999999)"
           DISPLAY
           "(-999, -9.99999999999999, 15nines, .999999999999999)"
           DISPLAY
           "(+238, +8.88888888345777, -456789112347702, -.3333)"
           DISPLAY  " "

           MOVE ZERO TO erracc.
            MOVE 1 TO flag.

      *    Ensure that table TV is empty

           EXEC SQL DELETE FROM TV END-EXEC.

      *    Load initial values

           MOVE "FILLX" TO SQLSTATE MOVE 99999 TO SQLCODE.

           EXEC SQL INSERT INTO TV
             VALUES
               (456,
                0.12345678912345,
                543210987654321,
                .123456789012345)
           END-EXEC.

           MOVE SQLCODE TO SQLCOD
           DISPLAY " After INSERT, Status = ", SQLSTATE " " SQLCOD.

           MOVE "FILLX" TO SQLSTATE MOVE 99999 TO SQLCODE.

           EXEC SQL INSERT INTO TV
             VALUES
               (999,
                9.99999999999999,
                999999999999999,
                .999999999999999)
           END-EXEC

           MOVE SQLCODE TO SQLCOD
            DISPLAY " "
            DISPLAY " After INSERT, Status = ", SQLSTATE " " SQLCOD.

           MOVE "FILLX" TO SQLSTATE MOVE 99999 TO SQLCODE.

           EXEC SQL INSERT INTO TV
             VALUES
             (-999,
              -9.99999999999999,
              999999999999999,
              .999999999999999)
           END-EXEC

           MOVE SQLCODE TO SQLCOD
            DISPLAY " "
           DISPLAY " After INSERT, Status = ", SQLSTATE " " SQLCOD.

           MOVE "FILLX" TO SQLSTATE MOVE 99999 TO SQLCODE.

           EXEC SQL INSERT INTO TV
             VALUES
             (+238,
              +8.88888888345777,
              -456789112347702,
              -.3333)
           END-EXEC

           MOVE SQLCODE TO SQLCOD
            DISPLAY " "
           DISPLAY " After INSERT, Status = ", SQLSTATE " " SQLCOD.

           EXEC SQL DECLARE DATA1 CURSOR
             FOR SELECT DEC3, DEC1514, DEC150, DEC1515
               FROM   TV
                 ORDER BY DEC3
           END-EXEC.

      *   Clear count of errors


           EXEC SQL OPEN DATA1 END-EXEC.
           DISPLAY " "
           DISPLAY "FETCH rows ordered by first column:"

           MOVE ZERO TO s903
           MOVE ZERO TO s9v914
           MOVE ZERO TO s915
           MOVE ZERO TO sv915
           MOVE "FILLX" TO SQLSTATE MOVE 99999 TO SQLCODE.

           EXEC SQL FETCH DATA1 INTO :s903, :s9v914, :s915, :sv915
           END-EXEC
           MOVE SQLCODE TO SQLCOD

           DISPLAY " "
           DISPLAY "FETCH row 1"
           PERFORM CHCKOK
           DISPLAY
            "values = " s903, " ", s9v914, " ", s915, " ", sv915.
           DISPLAY
            "Status = " SQLSTATE " " SQLCOD.
           IF
              (NORMSQ2 NOT = "00000" AND SQLCODE NOT = 0) OR
             s903     NOT = -999  OR
             s9v914   NOT = -9.99999999999999 OR
             s915     NOT = 999999999999999 OR
             sv915    NOT = .999999999999999
           THEN ADD 1 TO erracc  DISPLAY "* fail *".


           MOVE ZERO TO s903
           MOVE ZERO TO s9v914
           MOVE ZERO TO s915
           MOVE ZERO TO sv915
           MOVE "FILLX" TO SQLSTATE MOVE 99999 TO SQLCODE.

           EXEC SQL FETCH DATA1 INTO :s903, :s9v914, :s915, :sv915
           END-EXEC
           MOVE SQLCODE TO SQLCOD
      *
            DISPLAY " "
            DISPLAY "FETCH row 2"
            PERFORM CHCKOK
           IF
             (NORMSQ2 NOT = "00000" AND SQLCOD NOT = 0) OR
             s903    NOT = 238, OR
             s9v914  NOT = 8.88888888345777, OR
             s915    NOT = -456789112347702, OR
             sv915   NOT = -.3333
           THEN ADD 1 TO erracc  DISPLAY "* fail *".

           MOVE SQLCODE TO SQLCOD.
           DISPLAY
            "values = " s903, " ", s9v914, " ", s915, " ", sv915.
           DISPLAY
            "Status = " SQLSTATE " " SQLCOD.

           MOVE ZERO TO s903
           MOVE ZERO TO s9v914
           MOVE ZERO TO s915
           MOVE ZERO TO sv915
           MOVE "FILLX" TO SQLSTATE MOVE 99999 TO SQLCODE.

           EXEC SQL FETCH DATA1 INTO :s903, :s9v914, :s915, :sv915
           END-EXEC
           MOVE SQLCODE TO SQLCOD
      *
            DISPLAY " "
            DISPLAY "FETCH row 3"
            PERFORM CHCKOK
           IF
             (NORMSQ2 NOT = "00000" AND SQLCODE NOT = 0) OR
             s903    NOT = 456, OR
             s9v914  NOT = 0.12345678912345, OR
             s915    NOT = 543210987654321, OR
             sv915   NOT = .123456789012345
           THEN ADD 1 TO erracc  DISPLAY "* fail *".

           DISPLAY
            "values = " s903, " ", s9v914, " ", s915, " ", sv915.
           DISPLAY
            "Status = " SQLSTATE " " SQLCOD.

           MOVE ZERO TO s903
           MOVE ZERO TO s9v914
           MOVE ZERO TO s915
           MOVE ZERO TO sv915
           MOVE "FILLX" TO SQLSTATE MOVE 99999 TO SQLCODE.

           EXEC SQL FETCH DATA1 INTO :s903, :s9v914, :s915, :sv915
           END-EXEC
           MOVE SQLCODE TO SQLCOD

            DISPLAY " "
            DISPLAY "FETCH row 4"
            PERFORM CHCKOK
           IF
             (NORMSQ2 NOT = "00000" AND SQLCODE NOT = 0) OR
             s903    NOT = 999, OR
             s9v914  NOT = 9.99999999999999, OR
             s915    NOT = 999999999999999, OR
             sv915   NOT = .999999999999999
           THEN ADD 1 TO erracc  DISPLAY "* fail *".

           DISPLAY
            "values = " s903, " ", s9v914, " ", s915, " ", sv915.
           DISPLAY
            "Status = " SQLSTATE " " SQLCOD.

           EXEC SQL CLOSE DATA1 END-EXEC.

      *   Set up values for insertion into table

           MOVE -123 TO s903
           MOVE +1.1 TO s9v914
      *    MOVE 43521 TO s915
           MOVE -0.111112222233333 TO sv915

           DISPLAY " "
           DISPLAY "INSERT VALUES "
                 s9v914, " ", sv915, " ", s903, " ", sv915

           MOVE "STATE" TO SQLSTATE MOVE -999999 TO SQLCODE.
           EXEC SQL INSERT INTO TV (dec3, dec1514, dec150, dec1515)
             VALUES (:s9v914, :sv915, :s903, :sv915)
           END-EXEC.
           MOVE SQLCODE TO SQLCOD

            PERFORM CHCKOK
           IF
              NORMSQ2 NOT = "00000"
            AND
              SQLCODE NOT = 0
           THEN ADD 1 TO erracc  DISPLAY "* fail *".
           DISPLAY "INSERT - success expected - "
           "SQLSTATE = " SQLSTATE " SQLCODE = " SQLCOD.


            DISPLAY " "
           DISPLAY "INSERT VALUES "
                 s903, " ", s903, " ", s915, " ", s915.

           MOVE "FILLX" TO SQLSTATE MOVE 99999 TO SQLCODE.

           EXEC SQL INSERT INTO TV (dec3, dec1514, dec150, dec1515)
             VALUES
               (:s903, :s903, :s915, :s915)
           END-EXEC.

      *   Should fail because of most significant end truncation

           IF
             SQLSTATE NOT = "22003"
            AND
             SQLCODE NOT < 0
            THEN ADD 1 TO erracc  DISPLAY "* fail *".
           MOVE SQLCODE TO SQLCOD
           DISPLAY
            "INSERT - truncation expected, SQLSTATE 22003."
           DISPLAY "SQLSTATE = ", SQLSTATE " SQLCODE = " SQLCOD.
           DISPLAY " "

      *   Select single row that is present

           MOVE ZERO TO s903
           MOVE ZERO TO s9v914
           MOVE ZERO TO s915
           MOVE ZERO TO sv915
           MOVE "FILLX" TO SQLSTATE MOVE 99999 TO SQLCODE.

           DISPLAY "SELECT successfully inserted row"
           EXEC SQL SELECT *
              INTO :s903, :s9v914, :s915, :sv915
                FROM TV
                  WHERE DEC3 = 1
           END-EXEC
           MOVE SQLCODE TO SQLCOD
           PERFORM CHCKOK

           IF
             (NORMSQ2 NOT = "00000" AND SQLCODE NOT = 0) OR
             s903    NOT = 1, OR
             s9v914  NOT = -0.11111222223333, OR
             s915    NOT = -123, OR
             sv915   NOT = -0.111112222233333
           THEN ADD 1 TO erracc  DISPLAY "* fail *".
           DISPLAY
             "SELECT Single Row - success expected."
           DISPLAY "SQLSTATE = ", SQLSTATE " SQLCODE = " SQLCOD.
           DISPLAY "Values retrieved:"
           DISPLAY s903, " ", s9v914, " ", s915, " ", sv915.

      *    Attempt to retrieve a non-existent row

            MOVE 555           TO s903
            MOVE 7.003         TO s9v914
            MOVE +44612286333  TO s915
            MOVE -0.44612369877 TO sv915.

           MOVE "FILLX" TO SQLSTATE MOVE 99999 TO SQLCODE.

           DISPLAY " "
           DISPLAY "SELECT missing (failed INSERT) row"
           EXEC SQL SELECT *
              INTO :s903, :s9v914, :s915, :sv915
                FROM TV
                  WHERE DEC3 = -123
           END-EXEC

           PERFORM NOSUBCLASS THROUGH P213.
           IF
             (NORMSQ2 NOT = "02000" AND SQLCODE NOT = 100) OR
             s903    NOT = 555, OR
             s9v914  NOT = 7.003, OR
             s915    NOT = 44612286333, OR
             sv915   NOT = -0.44612369877
           THEN ADD 1 TO erracc  DISPLAY "* fail *".
            MOVE SQLCODE TO SQLCOD
           DISPLAY
            "SELECT Single Row - failure expected."
           DISPLAY "SQLSTATE = ", SQLSTATE " SQLCODE = " SQLCOD.
           DISPLAY " "

           EXEC SQL COMMIT WORK END-EXEC.

           IF erracc = 0 THEN
             DISPLAY " xop712.pco *** pass ***"
             EXEC SQL INSERT INTO XOPEN1.TESTREPORT
               VALUES('0712','pass','PCO') END-EXEC
           ELSE
             DISPLAY " xop712.pco *** fail ***"
             EXEC SQL INSERT INTO XOPEN1.TESTREPORT
               VALUES('0712','fail','PCO') END-EXEC
               COMPUTE errcnt = errcnt + 1
           END-IF

           DISPLAY
             "====================================================="
           DISPLAY  " "

           EXEC SQL COMMIT WORK END-EXEC

      ******************** END TEST0712 *********************
      ******************** BEGIN TEST0724 *******************

           DISPLAY " TEST0724"
            DISPLAY "X/O,MAPPING ONTO SQL SMALLINT, DECIMAL AND INTEGER"
           DISPLAY "references: ISO/IEC 9075:1992 6.1 & 19.5"
           DISPLAY " X/Open C201:1992 4.1.3"
           DISPLAY " - - - - - - - - - - - - - - - - - - -"
            DISPLAY " "
           DISPLAY " *** CREATE TABLE TU (smint SMALLINT "
           DISPLAY " dec1514 DECIMAL(15,14) "
           DISPLAY " integr INTEGER "
           DISPLAY " dec1515 DECIMAL(15,15)) "
            DISPLAY " "
           DISPLAY " *** INSERT INTO TU "
           DISPLAY " *** VALUES "
           DISPLAY
           "(456, -1.12345678912345, +2147483647, .123456789012345)"
           DISPLAY
           "(32767, 9.99999999999999, -2147483647, .999999999999999)"
           DISPLAY
           "(-32767, -9.99999999999999, +1234554321, -.999999999999999)"
           DISPLAY
           "(+238, +8.88888888345777, -2147483647, -0.3333)"
           DISPLAY  " "

            MOVE 1 TO flag.

      *    Ensure that table TU is empty

           EXEC SQL DELETE FROM TU END-EXEC.

      *    Load initial values

           MOVE "FILLX" TO SQLSTATE MOVE 99999 TO SQLCODE.

           EXEC SQL INSERT INTO TU
             VALUES
               (456,
                -1.12345678912345,
                +2147483647,
                .123456789012345)
           END-EXEC

           MOVE SQLCODE TO SQLCOD
            DISPLAY " "
           DISPLAY
             " After INSERT, Status = ", SQLSTATE " " SQLCOD.

           MOVE "FILLX" TO SQLSTATE MOVE 99999 TO SQLCODE.

           EXEC SQL INSERT INTO TU VALUES
               (32767,
                9.99999999999999,
                -2147483647,
                .999999999999999)
           END-EXEC

           MOVE SQLCODE TO SQLCOD
            DISPLAY " "
           DISPLAY
             " After INSERT, Status = ", SQLSTATE " " SQLCOD.

           MOVE "FILLX" TO SQLSTATE MOVE 99999 TO SQLCODE.

           EXEC SQL INSERT INTO TU VALUES
             (-32767,
              -9.99999999999999,
              +1234554321,
              -.999999999999999)
           END-EXEC

           MOVE SQLCODE TO SQLCOD
            DISPLAY " "
           DISPLAY
             " After INSERT, Status = ", SQLSTATE " " SQLCOD.

           MOVE "FILLX" TO SQLSTATE MOVE 99999 TO SQLCODE.

           EXEC SQL INSERT INTO TU VALUES
             (+238,
              +8.88888888345777,
              -2147483647,
              -0.3333)
           END-EXEC

           MOVE SQLCODE TO SQLCOD
            DISPLAY " "
           DISPLAY
             " After INSERT, Status = ", SQLSTATE " " SQLCOD.

           EXEC SQL DECLARE DATA2 CURSOR
             FOR SELECT SMINT, DEC1514, INTEGR, DEC1515
               FROM   TU
                 ORDER BY SMINT
           END-EXEC.

      *   Clear count of errors

           MOVE ZERO TO erracc.

           EXEC SQL OPEN DATA2 END-EXEC.
           DISPLAY " "
           DISPLAY "FETCH rows ordered by first column:"

           MOVE ZERO TO s95c3
           MOVE ZERO TO s9v914c3
           MOVE ZERO TO s910c3
           MOVE ZERO TO sv915c3
           MOVE "FILLX" TO SQLSTATE  MOVE 999999 TO SQLCODE.

           EXEC SQL FETCH DATA2 INTO
                      :s95c3, :s9v914c3, :s910c3, :sv915c3
           END-EXEC.
           MOVE SQLCODE TO SQLCOD.

           MOVE s95c3    TO s95d
           MOVE s9v914c3 TO s9v914d
           MOVE s910c3   TO s910d
           MOVE sv915c3  TO sv915d.
           DISPLAY " "
           DISPLAY "FETCH row 1"
           PERFORM CHCKOK
           DISPLAY
            "values = " s95d " ", s9v914d " ", s910d " ", sv915d.
           DISPLAY "Status = " SQLSTATE " " SQLCOD.
           IF
             (NORMSQ2 NOT = "00000" AND SQLCODE NOT = 0) OR
             s95c3     NOT = -32767, OR
             s9v914c3  NOT = -9.99999999999999, OR
             s910c3    NOT = +1234554321, OR
             sv915c3   NOT = -.999999999999999
           THEN ADD 1 TO erracc  DISPLAY "* fail *".

           MOVE ZERO TO s95c3
           MOVE ZERO TO s9v914c3
           MOVE ZERO TO s910c3
           MOVE ZERO TO sv915c3
           MOVE "FILLX" TO SQLSTATE MOVE 99999 TO SQLCODE.

           EXEC SQL FETCH DATA2 INTO
                       :s95c3, :s9v914c3, :s910c3, :sv915c3
           END-EXEC
           MOVE SQLCODE TO SQLCOD

           DISPLAY " "
           DISPLAY "FETCH row 2"
           PERFORM CHCKOK
           IF
             (NORMSQ2 NOT = "00000" AND SQLCODE NOT = 0) OR
             s95c3     NOT = 238, OR
             s9v914c3  NOT = 8.88888888345777, OR
             s910c3    NOT = -2147483647, OR
             sv915c3   NOT = -0.3333
           THEN ADD 1 TO erracc  DISPLAY "* fail *".
      *
           MOVE s95c3    TO s95d
           MOVE s9v914c3 TO s9v914d
           MOVE s910c3   TO s910d
           MOVE sv915c3  TO sv915d.
           DISPLAY
            "values = " s95d " ", s9v914d " ", s910d " ", sv915d.
           DISPLAY "Status = " SQLSTATE " " SQLCOD.

           MOVE ZERO TO s95c3
           MOVE ZERO TO s9v914c3
           MOVE ZERO TO s910c3
           MOVE ZERO TO sv915c3
           MOVE "FILLX" TO SQLSTATE MOVE 99999 TO SQLCODE.

           EXEC SQL FETCH DATA2 INTO
                      :s95c3, :s9v914c3, :s910c3, :sv915c3
           END-EXEC.
           MOVE SQLCODE TO SQLCOD

           DISPLAY " "
           DISPLAY "FETCH row 3"
           PERFORM CHCKOK
           IF
             (NORMSQ2 NOT = "00000" AND SQLCODE NOT = 0) OR
             s95c3     NOT = 456, OR
             s9v914c3  NOT = -1.12345678912345, OR
             s910c3    NOT = 2147483647, OR
             sv915c3   NOT = .123456789012345
           THEN ADD 1 TO erracc  DISPLAY "* fail *".
      *
           MOVE s95c3    TO s95d
           MOVE s9v914c3 TO s9v914d
           MOVE s910c3   TO s910d
           MOVE sv915c3  TO sv915d.
           DISPLAY
            "values = " s95d " ", s9v914d " ", s910d " ", sv915d.
           DISPLAY "Status = " SQLSTATE " " SQLCOD.


           MOVE ZERO TO s95c3
           MOVE ZERO TO s9v914c3
           MOVE ZERO TO s910c3
           MOVE ZERO TO sv915c3
           MOVE "FILLX" TO SQLSTATE MOVE 99999 TO SQLCODE.

           EXEC SQL FETCH DATA2 INTO
                      :s95c3, :s9v914c3, :s910c3, :sv915c3
           END-EXEC
           MOVE SQLCODE TO SQLCOD

           DISPLAY " "
           DISPLAY "FETCH row 4"
           PERFORM CHCKOK
           IF
             (NORMSQ2 NOT = "00000" AND SQLCODE NOT = 0) OR
             s95c3     NOT = 32767, OR
             s9v914c3  NOT = 9.99999999999999, OR
             s910c3    NOT = -2147483647, OR
             sv915c3   NOT = .999999999999999
           THEN ADD 1 TO erracc  DISPLAY "* fail *".
      *
           MOVE s95c3    TO s95d
           MOVE s9v914c3 TO s9v914d
           MOVE s910c3   TO s910d
           MOVE sv915c3  TO sv915d.
           DISPLAY
            "values = " s95d " ", s9v914d " ", s910d " ", sv915d.
           DISPLAY "Status = " SQLSTATE " " SQLCOD.

           EXEC SQL CLOSE DATA2 END-EXEC.

      *   Set up values for insertion into table

           MOVE -12345 TO s95c3
           MOVE +1.1 TO s9v914c3
           MOVE 43521 TO s910c3
           MOVE -0.111112222233333 TO sv915c3
           MOVE "XXXXX" TO SQLSTATE MOVE 999999 TO SQLCODE.

           EXEC SQL INSERT INTO TU
             VALUES
               (:s9v914c3, :s9v914c3, :s95c3, :sv915c3)
           END-EXEC.
           MOVE SQLCODE TO SQLCOD

           DISPLAY " "
           PERFORM CHCKOK
           IF
             NORMSQ2 NOT = "00000"
            AND
             SQLCODE NOT = 0
            THEN ADD 1 TO erracc  DISPLAY "* fail *".
           DISPLAY "INSERT - success expected - "
           "SQLSTATE = " SQLSTATE " SQLCODE = " SQLCOD.


           MOVE "STATE" TO SQLSTATE MOVE 999999 TO SQLCODE.
           EXEC SQL INSERT INTO TU
             VALUES
               (:s95c3, :s95c3, :s910c3, :s910c3)
           END-EXEC.
           MOVE SQLCODE TO SQLCOD

      *   Should fail because of most significant end truncation

           DISPLAY " "
           IF
             SQLSTATE NOT = "22003"
            AND
             SQLCODE NOT < 0
            THEN ADD 1 TO erracc  DISPLAY "* fail *".

           DISPLAY "INSERT - failure expected - "
           "SQLSTATE = " SQLSTATE " SQLCODE = " SQLCOD.


      *   Select single row that is present

           MOVE "YYYYY" TO SQLSTATE MOVE 999999 TO SQLCODE.
           EXEC SQL SELECT *
              INTO :s95c3, :s9v914c3, :s910c3, :sv915c3
                  FROM TU
                 WHERE SMINT = 1
           END-EXEC
           MOVE SQLCODE TO SQLCOD

            DISPLAY " "
            PERFORM CHCKOK
           IF
             (NORMSQ2 NOT = "00000" AND SQLCODE NOT = 0) OR
             s95c3     NOT = 1, OR
             s9v914c3  NOT = 1.1, OR
             s910c3    NOT = -12345, OR
             sv915c3   NOT = -0.111112222233333
           THEN ADD 1 TO erracc  DISPLAY "* fail *".

           DISPLAY "SELECT - success expected - "
           "SQLSTATE = " SQLSTATE " SQLCODE = " SQLCOD.

      *    Attempt to retrieve a non-existent row

      *    Set known values into destination fields

           MOVE 32567          TO s95c3
           MOVE 7.003          TO s9v914c3
           MOVE +2147228633    TO s910c3
           MOVE -0.44612369877 TO sv915c3.
           MOVE "STATE" TO SQLSTATE  MOVE 999999 TO SQLCODE.

           EXEC SQL SELECT *
              INTO :s95c3, :s9v914c3, :s910c3, :sv915c3
                FROM TU
                  WHERE SMINT = -123
           END-EXEC

            PERFORM NOSUBCLASS THROUGH P213.
           IF
             (NORMSQ2 NOT = "02000" AND SQLCODE NOT = 100) OR
             s95c3     NOT = 32567, OR
             s9v914c3  NOT = 7.003, OR
             s910c3    NOT = 2147228633, OR
             sv915c3   NOT = -0.44612369877
           THEN ADD 1 TO erracc  DISPLAY "* fail *".

           MOVE SQLCODE TO SQLCOD
            DISPLAY " "
           DISPLAY "SELECT - failure expected - "
           "SQLSTATE = " SQLSTATE " SQLCODE = " SQLCOD.
           DISPLAY " "


           EXEC SQL COMMIT WORK END-EXEC.

           IF erracc = 0 THEN
             DISPLAY " xop712.pco *** pass ***"
             EXEC SQL INSERT INTO XOPEN1.TESTREPORT
               VALUES('0724','pass','PCO') END-EXEC
           else
             DISPLAY " xop712.pco *** fail ***"
             EXEC SQL INSERT INTO XOPEN1.TESTREPORT
               VALUES('0724','fail','PCO') END-EXEC
               COMPUTE errcnt = errcnt + 1
           END-IF

           DISPLAY
             "====================================================="
           DISPLAY  " "

           EXEC SQL COMMIT WORK END-EXEC

      ******************** END TEST0724 *******************

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

       NOSUBCLASS.

      *This routine replaces valid implementation defined
      *subclasses with 000. This replacement equates valid
      *implementation-defined subclasses with the 000 value
      *expected by the test case; otherwise the test will
      *fail. After calling NOSUBCLASS, NORMSQ will be tested
      *                             SQLSTATE will be printed

             MOVE SQLSTATE TO SQLSTORE
      *subclass begins in position 3 of char array NORMSQ
             MOVE 3 TO norm1
             MOVE 14 TO norm2
             PERFORM UNTIL norm2 > 36
             if (NORMSQ(norm1)  =  ALPNUM3(norm2)) then
               MOVE "0" TO NORMSQ(norm1)
             END-IF
              ADD 1 TO norm2
              END-PERFORM
             MOVE SQLS2 TO NORMSQ2
             if (NORMSQ2   =   SQLSTATE) then
               GO TO P213
             END-IF
      *Quit if NORMSQ is unchanged. Subclass is not impl.def
      *Changed NORMSQ means implementation-defined subclass,
      *so proceed to zero it out, if valid (0-9, A-Z)

             MOVE 4 TO norm1
      *examining position 4 of char array NORMSQ
             MOVE 1 TO norm2
             PERFORM UNTIL norm2 > 36
             if (NORMSQ(norm1)  =  ALPNUM3(norm2)) then
               MOVE "0" TO NORMSQ(norm1)
             END-IF
              ADD 1 TO norm2
              END-PERFORM
             MOVE 5 TO norm1
      *examining position 5 of char array NORMSQ
             MOVE 1 TO norm2
             PERFORM UNTIL norm2 > 36
             if (NORMSQ(norm1)  =  ALPNUM3(norm2)) then
               MOVE "0" TO NORMSQ(norm1)
             END-IF
              ADD 1 TO norm2
              END-PERFORM

      *implementation-defined subclasses are allowed for warnings
      *(class = 01). These equate to successful completion
      *SQLSTATE values of 00000.
      *reference SQL-92. 4.28 SQL-transactions, paragraph 2

             if (NORMSQ(1)  =  "0"  AND  NORMSQ(2)  =  "1") then
               MOVE "0" TO NORMSQ(2)
             END-IF
              MOVE SQLS2 TO NORMSQ2.

        P213.

      *Test SQLCODE and SQLSTATE for normal completion

       CHCKOK.
             MOVE 1 TO flag
             DISPLAY "SQLCODE should be 0; its value is ", SQLCOD
             DISPLAY "SQLSTATE should be 00000; its value is ", SQLSTATE

             PERFORM NOSUBCLASS THROUGH P213.
             if (SQLCODE  NOT =  0  OR  NORMSQ2  NOT  =   "00000") then
               MOVE 0 TO flag
             END-IF
             if (flag  = 1  AND  NORMSQ2  NOT  =   SQLSTATE) then
               DISPLAY "Valid implementation defined SQLSTATE accepted."
             END-IF

           .

quality100%

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