Quelle dml149.cob Sprache: Cobol

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

      * Standard COBOL (file "DML149.SCO") calling SQL
      * procedures in file "DML149.MCO".

      ****************************************************************
      *
      *                 COMMENT SECTION
      *
      * DATE 1995/02/13 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.
      *
      * DML149.SCO
      * WRITTEN BY:  David W. Flater and Joan Sullivan
      * TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE
      *
      * This routine tests SET TRANSACTION and CAST.
      *
      * REFERENCES
      *   F# 11 -- Transaction isolation
      *   14.1 -- <set transaction statement>
      *   6.10 -- <cast specification>
      *
      ****************************************************************

      * EXEC SQL BEGIN DECLARE SECTION END-EXEC
       01  SQLCODE PIC S9(9) COMP.
       01  SQLSTATE PIC  X(5).
       01  uid PIC  X(18).
       01  uidx PIC  X(18).
       01  flt1 PIC S9(4)V9(4) DISPLAY SIGN LEADING SEPARATE.
       01  int1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  ch5 PIC  X(5).
       01  ch10 PIC  X(10).
       01  indic1 PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
      *  EXEC SQL END DECLARE SECTION END-EXEC
       01  FLT-1 PIC -(5).9999.
       01  norm1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  norm2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  ALPNUM-TABLE VALUE IS
               "01234ABCDEFGH56789IJKLMNOPQRSTUVWXYZ".
           05  ALPNUM PIC X OCCURS 36 TIMES.
       01  NORMSQ.
           05  NORMSQX PIC X OCCURS 5 TIMES.
       01  errcnt PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
      *date_time declaration
       01  TO-DAY PIC 9(6).
       01  THE-TIME PIC 9(8).
       01  flag PIC S9(9) DISPLAY SIGN LEADING SEPARATE.

       01  SQL-COD PIC S9(9) DISPLAY SIGN LEADING SEPARATE.

       PROCEDURE DIVISION.
       P0.

             MOVE "FLATER " 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 SQLSTATE uidx
             MOVE SQLCODE TO SQL-COD
      *  EXEC SQL ROLLBACK WORK;
             CALL "SUB2" USING SQLCODE SQLSTATE
             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
           "SQL Test Suite, V6.0, Module COBOL, dml149.sco"
             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 TEST0561 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0561 "
             DISPLAY " Double SET TRANSACTION"
             DISPLAY "References:"
             DISPLAY " F# 11 -- Transaction isolation"
             DISPLAY " 14.1 -- "
             DISPLAY " 4.22.6 -- transaction statements do not
      -    " initiate a transaction"
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             COMPUTE SQLCODE = -1
             MOVE "xxxxx" TO SQLSTATE

      *Make very sure there is no transaction outstanding
             DISPLAY "ROLLBACK WORK;"
      *  EXEC SQL ROLLBACK WORK;
             CALL "SUB3" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

      *TEd hook:  arararararar
             DISPLAY "SET TRANSACTION READ ONLY;"
      *  EXEC SQL SET TRANSACTION READ ONLY;
             CALL "SUB4" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "SET TRANSACTION READ WRITE;"
      *  EXEC SQL SET TRANSACTION READ WRITE;
             CALL "SUB5" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO USIG VALUES (10, 20);"
      *  EXEC SQL INSERT INTO USIG VALUES (10, 20);
             CALL "SUB6" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "ROLLBACK WORK;"
      *  EXEC SQL ROLLBACK WORK;
             CALL "SUB7" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *TEd hook:  arararararar
             DISPLAY "SET TRANSACTION READ WRITE;"
      *  EXEC SQL SET TRANSACTION READ WRITE;
             CALL "SUB8" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "SET TRANSACTION READ ONLY;"
      *  EXEC SQL SET TRANSACTION READ ONLY;
             CALL "SUB9" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO USIG VALUES (10, 20);"
      *  EXEC SQL INSERT INTO USIG VALUES (10, 20);
             CALL "SUB10" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 25000; its value is ", SQLSTATE
           PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE  NOT <  0  OR  NORMSQ  NOT  =   "25000") then
               MOVE 0 TO flag
             END-IF
             if (NORMSQ   =   "25000"  AND  NORMSQ  NOT  =   SQLSTATE)
             then
               DISPLAY "Valid implementation-defined SQLSTATE accepted."
             END-IF
             DISPLAY  " "

             DISPLAY "ROLLBACK WORK;"
      *  EXEC SQL ROLLBACK WORK;
             CALL "SUB11" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0561','pass','MCO');
               CALL "SUB12" USING SQLCODE SQLSTATE
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml149.sco *** fail *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0561','fail','MCO');
               CALL "SUB13" USING SQLCODE SQLSTATE
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
             END-IF

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

      *  EXEC SQL COMMIT WORK;
             CALL "SUB14" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
      ******************** END TEST0561 ********************
      ******************** BEGIN TEST0846 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0846 "
             DISPLAY "Feature 20, CAST functions (static) nits"
             DISPLAY "References:"
             DISPLAY " F# 20 -- CAST functions"
             DISPLAY " 6.10 -- "
             DISPLAY " 6.11 LR.2.d -- in a
      -    " primary>"
             DISPLAY " 13.8 LR.2.a -- in
      -    " statement>"
             DISPLAY " F# 21 -- INSERT expressions"
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             COMPUTE SQLCODE = -1
             MOVE "xxxxx" TO SQLSTATE

             DISPLAY "CREATE TABLE NO_DUCK ("
             DISPLAY " GOOSE NUMERIC (4, 2),"
             DISPLAY " ALBATROSS FLOAT,"
             DISPLAY " SEAGULL INT,"
             DISPLAY " OSPREY CHAR (10));"
      *  EXEC SQL CREATE TABLE NO_DUCK (
      *    GOOSE       NUMERIC (4, 2),
      *    ALBATROSS   FLOAT,
      *    SEAGULL     INT,
      *    OSPREY      CHAR (10));
             CALL "SUB15" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "COMMIT WORK;"
      *  EXEC SQL COMMIT WORK;
             CALL "SUB16" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      * 1.  In numeric-to-numeric cast, loss of leading significant
      *     digits raises SQLSTATE 22003.  GR.3.a.ii  GR.4.a.ii

      *6.10 GR.3.a.ii any numeric to exact numeric losing leading sig
             DISPLAY "CAST (100 AS NUMERIC (2)) loses the leading
      -    " significant digit"
             DISPLAY "SELECT CAST (100 AS NUMERIC (2))"
             DISPLAY " INTO :flt1 FROM HU.ECCO;"
      *  EXEC SQL SELECT CAST (100 AS NUMERIC (2))
      *    INTO :flt1 FROM HU.ECCO;
             CALL "SUB17" USING SQLCODE SQLSTATE flt1
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             if (SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF
             if (SQLCODE  NOT <  0  AND  SQLCODE  NOT =  100) then
               MOVE flt1 TO FLT-1
               DISPLAY "flt1 should not be returned; its value is ",
                  FLT-1
             END-IF
             DISPLAY "SQLSTATE should be 22003; its value is ", SQLSTATE
             if (SQLSTATE  NOT  =   "22003") then
               MOVE 0 TO flag
             END-IF

      *6.10 GR.4.a.ii any numeric to approx numeric losing leading sig
      *Not testable.

      * 2.  In numeric-to-numeric cast, rounding or truncation is OK
      *     (supported without exception).  GR.3.a.i  GR.4.a.i

      *6.10 GR.3.a.i any numeric to exact numeric losing low order dig
             MOVE 0 TO int1
             DISPLAY "SELECT CAST (100.5 AS DECIMAL (3))"
             DISPLAY " INTO :int1 FROM HU.ECCO;"
      *  EXEC SQL SELECT CAST (100.5 AS DECIMAL (3))
      *    INTO :int1 FROM HU.ECCO;
             CALL "SUB18" USING SQLCODE SQLSTATE int1
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "int1 should be 100 or 101; its value is ", int1
             if (int1  NOT =  100  AND  int1  NOT =  101) then
               MOVE 0 TO flag
             END-IF

      * 3.  Leading or trailing blanks are removed from a character
      *     string before cast to numeric.  GR.3.b  GR.4.b

      *to exact numeric

             DISPLAY "INSERT INTO NO_DUCK VALUES ("
             DISPLAY " CAST (' 23.23 ' AS NUMERIC (4, 2)), 1.57E-1,
      -    " -9, 'QUACK');"
      *  EXEC SQL INSERT INTO NO_DUCK VALUES (
      *    CAST ('  23.23 ' AS NUMERIC (4, 2)), 1.57E-1, -9,
      *  'QUACK');
             CALL "SUB19" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             MOVE 0 TO int1
             DISPLAY "SELECT COUNT(*) INTO :int1"
             DISPLAY " FROM NO_DUCK WHERE GOOSE = 23.23;"
      *  EXEC SQL SELECT COUNT(*) INTO :int1
      *    FROM NO_DUCK WHERE GOOSE = 23.23;
             CALL "SUB20" USING SQLCODE SQLSTATE int1
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "int1 should be 1; its value is ", int1
             if (int1  NOT =  1) then
               MOVE 0 TO flag
             END-IF

      *to approximate numeric

             DISPLAY "DELETE FROM NO_DUCK"
             DISPLAY " WHERE ALBATROSS - CAST (' 15.5E0 ' AS
      -    " FLOAT) < 3E-1;"
      *  EXEC SQL DELETE FROM NO_DUCK
      *    WHERE ALBATROSS - CAST ('   15.5E0    ' AS FLOAT) < 3E-1
      * ;
             CALL "SUB21" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             MOVE 10 TO int1
             DISPLAY "SELECT COUNT(*) INTO :int1 FROM NO_DUCK;"
      *  EXEC SQL SELECT COUNT(*) INTO :int1 FROM NO_DUCK;
             CALL "SUB22" USING SQLCODE SQLSTATE int1
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "int1 should be 0; its value is ", int1
             if (int1  NOT =  0) then
               MOVE 0 TO flag
             END-IF

      * 4.  Garbage string cast to numeric raises SQLSTATE 22018.
      *     GR.3.b.i  GR.4.b.i

             DISPLAY "INSERT INTO NO_DUCK"
             DISPLAY " SELECT 22.22, CAST (C1 AS FLOAT), 0, C1 FROM
      -    " HU.ECCO;"
      *  EXEC SQL INSERT INTO NO_DUCK
      *    SELECT 22.22, CAST (C1 AS FLOAT), 0, C1 FROM HU.ECCO
      * ;
             CALL "SUB23" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             if (SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF
             DISPLAY "SQLSTATE should be 22018; its value is ", SQLSTATE
             if (SQLSTATE  NOT  =   "22018") then
               MOVE 0 TO flag
             END-IF

             DISPLAY "INSERT INTO NO_DUCK"
             DISPLAY " SELECT 22.22, 2.222E1, CAST (C1 AS INT),
      -    " 'QUACK!' FROM HU.ECCO;"
      *  EXEC SQL INSERT INTO NO_DUCK
      *    SELECT 22.22, 2.222E1, CAST (C1 AS INT), 'QUACK!' FROM
      *  HU.ECCO;
             CALL "SUB24" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             if (SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF
             DISPLAY "SQLSTATE should be 22018; its value is ", SQLSTATE
             if (SQLSTATE  NOT  =   "22018") then
               MOVE 0 TO flag
             END-IF

      * 5.  An exact numeric cast to string gives the shortest literal
      *     with correct scale (including trailing zeroes).  GR.5.a

             MOVE 3 TO int1
             MOVE "zxyxu" TO ch5
             DISPLAY "SELECT CAST (CAST (:int1 AS DEC (5, 3)) AS CHAR
      -    " (5))"
             DISPLAY " INTO :ch5 FROM HU.ECCO;"
      *  EXEC SQL SELECT CAST (CAST (:int1 AS DEC (5, 3)) AS CHAR
      *  (5))
      *    INTO :ch5 FROM HU.ECCO;
             CALL "SUB25" USING SQLCODE SQLSTATE int1 ch5
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "ch5 should be '3.000'; its value is '"
      -     ch5,  "'"
             if (ch5  NOT  =   "3.000") then
               MOVE 0 TO flag
             END-IF

      * 6.  Exact numeric to string cast gives leading hypen for negat
      *     numbers, no blanks or plus sign for non-negative numbers.
      *     GR.5.a

             DISPLAY "INSERT INTO NO_DUCK VALUES ("
             DISPLAY " 12.00, -10.5E0, 12, 'QUACK!');"
      *  EXEC SQL INSERT INTO NO_DUCK VALUES (
      *    12.00, -10.5E0, 12, 'QUACK!');
             CALL "SUB26" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *WHERE clause has 'merely comparable' data types

             DISPLAY "UPDATE NO_DUCK"
             DISPLAY " SET OSPREY = CAST (GOOSE AS CHAR (10))"
             DISPLAY " WHERE SEAGULL = CAST (GOOSE AS DEC);"
      *  EXEC SQL UPDATE NO_DUCK
      *    SET OSPREY = CAST (GOOSE AS CHAR (10))
      *    WHERE SEAGULL = CAST (GOOSE AS DEC);
             CALL "SUB27" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             MOVE "axbxcxdxex" TO ch10
             DISPLAY "SELECT OSPREY INTO :ch10"
             DISPLAY " FROM NO_DUCK;"
      *  EXEC SQL SELECT OSPREY INTO :ch10
      *    FROM NO_DUCK;
             CALL "SUB28" USING SQLCODE SQLSTATE ch10
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "ch10 should be '12.00 '; its value is '",
             ch10 "'"
             if (ch10  NOT  =   "12.00 ") then
               MOVE 0 TO flag
             END-IF

             MOVE 1 TO int1
             DISPLAY "int1 = 1"
             MOVE "arrrrrrrgh" TO ch10
             DISPLAY "SELECT OSPREY INTO :ch10"
             DISPLAY " FROM NO_DUCK"
             DISPLAY " WHERE OSPREY < CAST (SEAGULL + :int1 AS CHAR
      -    " (10))"
             DISPLAY " AND OSPREY = CAST (GOOSE * :int1 AS CHAR (10));"
      *  EXEC SQL SELECT OSPREY INTO :ch10
      *    FROM NO_DUCK
      *    WHERE OSPREY < CAST (SEAGULL + :int1 AS CHAR (10))
      *    AND OSPREY = CAST (GOOSE * :int1 AS CHAR (10));
             CALL "SUB29" USING SQLCODE SQLSTATE ch10 int1 int1
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "ch10 should be '12.00 '; its value is '",
             ch10 "'"
             if (ch10  NOT  =   "12.00 ") then
               MOVE 0 TO flag
             END-IF

             DISPLAY "UPDATE NO_DUCK"
             DISPLAY " SET OSPREY = CAST (-SEAGULL AS CHAR (10));"
      *  EXEC SQL UPDATE NO_DUCK
      *    SET OSPREY = CAST (-SEAGULL AS CHAR (10));
             CALL "SUB30" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             MOVE "axbxcxdxex" TO ch10
             DISPLAY "SELECT OSPREY INTO :ch10"
             DISPLAY " FROM NO_DUCK;"
      *  EXEC SQL SELECT OSPREY INTO :ch10
      *    FROM NO_DUCK;
             CALL "SUB31" USING SQLCODE SQLSTATE ch10
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "ch10 should be '-12 '; its value is '",
             ch10 "'"
             if (ch10  NOT  =   "-12 ") then
               MOVE 0 TO flag
             END-IF

      * 7.  Exact numeric to string cast raises SQLSTATE 22001 on
      *     right truncation.  GR.5.a.iv

             DISPLAY "Expected value -12.00 is too long for CHAR (5)
      -    " cast"
             DISPLAY "SELECT CAST (-GOOSE AS CHAR (5)) INTO :ch10"
             DISPLAY " FROM NO_DUCK;"
      *  EXEC SQL SELECT CAST (-GOOSE AS CHAR (5)) INTO :ch10
      *    FROM NO_DUCK;
             CALL "SUB32" USING SQLCODE SQLSTATE ch10
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             if (SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF
             if (SQLCODE  NOT <  0  AND  SQLCODE  NOT =  100) then
               DISPLAY "ch10 should not be returned; its value is ",
             ch10
             END-IF
             DISPLAY "SQLSTATE should be 22001; its value is ", SQLSTATE
             if (SQLSTATE  NOT  =   "22001") then
               MOVE 0 TO flag
             END-IF

      * 8.  Approximate numeric value zero cast to string is 0E0.
      *     GR.5.b.i.1

             MOVE 0.0 TO flt1
             DISPLAY "flt1 = 0.0"
             DISPLAY "UPDATE NO_DUCK"
             DISPLAY " SET ALBATROSS = :flt1;"
      *  EXEC SQL UPDATE NO_DUCK
      *    SET ALBATROSS = :flt1;
             CALL "SUB33" USING SQLCODE SQLSTATE flt1
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *-0E0 should never happen

             MOVE "zxyxu" TO ch5
             DISPLAY "SELECT CAST (-ALBATROSS AS CHAR (5))"
             DISPLAY " INTO :ch5 FROM NO_DUCK;"
      *  EXEC SQL SELECT CAST (-ALBATROSS AS CHAR (5))
      *    INTO :ch5 FROM NO_DUCK;
             CALL "SUB34" USING SQLCODE SQLSTATE ch5
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "ch5 should be '0E0 '; its value is '"
      -     ch5 "'"
             if (ch5  NOT  =   "0E0 ") then
               MOVE 0 TO flag
             END-IF

      * 9.  Approximate numeric cast to string normalized; i.e.,
      *     starts with 1-9 (after any hypen), followed by period.
      *     GR.5.b.i.2  GR.5.b.ii

             MOVE "axbxcxdxex" TO ch10
             DISPLAY "SELECT CAST (0230E-1 AS CHAR (10)) INTO :ch10"
             DISPLAY " FROM HU.ECCO;"
      *  EXEC SQL SELECT CAST (0230E-1 AS CHAR (10)) INTO :ch10
      *    FROM HU.ECCO;
             CALL "SUB35" USING SQLCODE SQLSTATE ch10
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "ch10 should be '2.3E1 '; its value is '",
             ch10 "'"
             if (ch10  NOT  =   "2.3E1 ") then
               MOVE 0 TO flag
             END-IF

             MOVE "axbxcxdxex" TO ch10
             DISPLAY "SELECT CAST (0230E+1 AS CHAR (10)) INTO :ch10"
             DISPLAY " FROM HU.ECCO;"
      *  EXEC SQL SELECT CAST (0230E+1 AS CHAR (10)) INTO :ch10
      *    FROM HU.ECCO;
             CALL "SUB36" USING SQLCODE SQLSTATE ch10
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "ch10 should be '2.3E3 '; its value is '",
             ch10 "'"
             if (ch10  NOT  =   "2.3E3 ") then
               MOVE 0 TO flag
             END-IF

      * 10. An approximate numeric cast to string gives the shortest l
      *     GR.5.b.i.2
      * This is adequately covered in the other subtests.

      * 11. Approximate numeric to string cast gives leading hypen for
      *     negative numbers and negative exponent, no leading blanks
      *     plus sign for non-negative numbers.  GR.5.b.ii

             DISPLAY "DELETE FROM NO_DUCK;"
      *  EXEC SQL DELETE FROM NO_DUCK;
             CALL "SUB37" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO NO_DUCK VALUES ("
             DISPLAY " 0.00, -10.5E0, -0, 'QUACK!');"
      *  EXEC SQL INSERT INTO NO_DUCK VALUES (
      *    0.00, -10.5E0, -0, 'QUACK!');
             CALL "SUB38" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *Negative number, positive exponent
      *WHERE clause has 'merely comparable' data types

             DISPLAY "UPDATE NO_DUCK"
             DISPLAY " SET OSPREY = CAST (ALBATROSS AS CHAR (10))"
             DISPLAY " WHERE GOOSE = CAST (SEAGULL AS NUMERIC (2));"
      *  EXEC SQL UPDATE NO_DUCK
      *    SET OSPREY = CAST (ALBATROSS AS CHAR (10))
      *    WHERE GOOSE = CAST (SEAGULL AS NUMERIC (2));
             CALL "SUB39" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             MOVE "xxxxxyyyyy" TO ch10
             DISPLAY "SELECT OSPREY INTO :ch10"
             DISPLAY " FROM NO_DUCK;"
      *  EXEC SQL SELECT OSPREY INTO :ch10
      *    FROM NO_DUCK;
             CALL "SUB40" USING SQLCODE SQLSTATE ch10
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "ch10 should be '-1.05E1 '; its value is '",
             ch10 "'"
             if (ch10  NOT  =   "-1.05E1 ") then
               MOVE 0 TO flag
             END-IF

      *Negative number, negative exponent

             DISPLAY "UPDATE NO_DUCK SET ALBATROSS = -0.5;"
      *  EXEC SQL UPDATE NO_DUCK SET ALBATROSS = -0.5;
             CALL "SUB41" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "UPDATE NO_DUCK"
             DISPLAY " SET OSPREY = CAST (ALBATROSS AS CHAR (10));"
      *  EXEC SQL UPDATE NO_DUCK
      *    SET OSPREY = CAST (ALBATROSS AS CHAR (10));
             CALL "SUB42" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             MOVE "xxxxxyyyyy" TO ch10
             DISPLAY "SELECT OSPREY INTO :ch10"
             DISPLAY " FROM NO_DUCK;"
      *  EXEC SQL SELECT OSPREY INTO :ch10
      *    FROM NO_DUCK;
             CALL "SUB43" USING SQLCODE SQLSTATE ch10
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "ch10 should be '-5E-1 '; its value is '",
             ch10 "'"
             if (ch10  NOT  =   "-5E-1 ") then
               MOVE 0 TO flag
             END-IF

      *Positive number, negative exponent

             DISPLAY "UPDATE NO_DUCK"
             DISPLAY " SET OSPREY = CAST (-ALBATROSS AS CHAR (10));"
      *  EXEC SQL UPDATE NO_DUCK
      *    SET OSPREY = CAST (-ALBATROSS AS CHAR (10));
             CALL "SUB44" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             MOVE "xxxxxyyyyy" TO ch10
             DISPLAY "SELECT OSPREY INTO :ch10"
             DISPLAY " FROM NO_DUCK;"
      *  EXEC SQL SELECT OSPREY INTO :ch10
      *    FROM NO_DUCK;
             CALL "SUB45" USING SQLCODE SQLSTATE ch10
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "ch10 should be '5E-1 '; its value is '",
             ch10 "'"
             if (ch10  NOT  =   "5E-1 ") then
               MOVE 0 TO flag
             END-IF

      *Positive / positive already done

      * 12. Approximate numeric to string cast raises SQLSTATE 22001 o
      *     right truncation.  GR.5.b.iii.4

             DISPLAY "Expected value -5E-1 is too long for CHAR (4)
      -    " cast"
             DISPLAY "SELECT CAST (ALBATROSS AS CHAR (4)) INTO :ch10"
             DISPLAY " FROM NO_DUCK;"
      *  EXEC SQL SELECT CAST (ALBATROSS AS CHAR (4)) INTO :ch10
      *    FROM NO_DUCK;
             CALL "SUB46" USING SQLCODE SQLSTATE ch10
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             if (SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF
             if (SQLCODE  NOT <  0  AND  SQLCODE  NOT =  100) then
               DISPLAY "ch10 should not be returned; its value is ",
             ch10
             END-IF
             DISPLAY "SQLSTATE should be 22001; its value is ", SQLSTATE
             if (SQLSTATE  NOT  =   "22001") then
               MOVE 0 TO flag
             END-IF

      * 13. Cast of literal NULL yields NULL value.  GR.2.a

             DISPLAY "DECLARE L_OEUF CURSOR FOR"
             DISPLAY " SELECT CAST (NULL AS CHAR (10)), GOOSE FROM
      -    " NO_DUCK"
             DISPLAY " WHERE SEAGULL = 0"
             DISPLAY " UNION"
             DISPLAY " SELECT OSPREY, CAST (SEAGULL AS NUMERIC (4, 2))
      -    " FROM NO_DUCK"
             DISPLAY " WHERE GOOSE > 10000;"
      *  EXEC SQL DECLARE L_OEUF CURSOR FOR
      *    SELECT CAST (NULL AS CHAR (10)), GOOSE FROM NO_DUCK
      *    WHERE SEAGULL = 0
      *    UNION
      *    SELECT OSPREY, CAST (SEAGULL AS NUMERIC (4, 2)) FROM
      *  NO_DUCK
      *    WHERE GOOSE > 10000 END-EXEC

             DISPLAY "OPEN L_OEUF;"
      *  EXEC SQL OPEN L_OEUF;
             CALL "SUB47" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             MOVE 50 TO indic1
             DISPLAY "FETCH L_OEUF INTO :ch10:indic1, :int1;"
      *  EXEC SQL FETCH L_OEUF INTO :ch10:indic1, :int1;
             CALL "SUB48" USING SQLCODE SQLSTATE ch10 indic1 int1
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "indic1 should be -1; its value is ", indic1
             if (indic1  NOT =  -1) then
               MOVE 0 TO flag
             END-IF

             DISPLAY "CLOSE L_OEUF;"
      *  EXEC SQL CLOSE L_OEUF;
             CALL "SUB49" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      * 14. Cast of column or parameter with NULL value yields NULL va
      *     GR.2.a

             MOVE "NOTNULL " TO ch10
             COMPUTE indic1 = -1
             DISPLAY "indic1 = -1"
             DISPLAY "UPDATE NO_DUCK SET GOOSE ="
             DISPLAY " CAST (:ch10:indic1 AS NUMERIC (2, 2));"
      *  EXEC SQL UPDATE NO_DUCK SET GOOSE =
      *    CAST (:ch10:indic1 AS NUMERIC (2, 2));
             CALL "SUB50" USING SQLCODE SQLSTATE ch10 indic1
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             MOVE 50 TO int1
             DISPLAY "SELECT COUNT(*) INTO :int1"
             DISPLAY " FROM NO_DUCK WHERE GOOSE IS NULL;"
      *  EXEC SQL SELECT COUNT(*) INTO :int1
      *    FROM NO_DUCK WHERE GOOSE IS NULL;
             CALL "SUB51" USING SQLCODE SQLSTATE int1
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "int1 should be 1; its value is ", int1
             if (int1  NOT =  1) then
               MOVE 0 TO flag
             END-IF

             MOVE 50 TO indic1
             DISPLAY "SELECT CAST (GOOSE AS INT) INTO :int1:indic1"
             DISPLAY " FROM NO_DUCK;"
      *  EXEC SQL SELECT CAST (GOOSE AS INT) INTO :int1:indic1
      *    FROM NO_DUCK;
             CALL "SUB52" USING SQLCODE SQLSTATE int1 indic1
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "indic1 should be -1; its value is ", indic1
             if (indic1  NOT =  -1) then
               MOVE 0 TO flag
             END-IF

             DISPLAY "ROLLBACK WORK;"
      *  EXEC SQL ROLLBACK WORK;
             CALL "SUB53" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "DROP TABLE NO_DUCK CASCADE;"
      *  EXEC SQL DROP TABLE NO_DUCK CASCADE;
             CALL "SUB54" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "COMMIT WORK;"
      *  EXEC SQL COMMIT WORK;
             CALL "SUB55" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0846','pass','MCO');
               CALL "SUB56" USING SQLCODE SQLSTATE
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml149.sco *** fail *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0846','fail','MCO');
               CALL "SUB57" USING SQLCODE SQLSTATE
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
             END-IF

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

      *  EXEC SQL COMMIT WORK;
             CALL "SUB58" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
      ******************** END TEST0846 ********************
      **** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0
           STOP RUN.

      *    ****  Procedures for PERFORM statements

      *Test SQLCODE and SQLSTATE for normal completion.
       CHCKOK.
             DISPLAY "SQLCODE should be 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 00000; its value is ", SQLSTATE
             PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE NOT =  0  OR   NORMSQ NOT = "00000") then
               MOVE 0 TO flag
             END-IF
             if (NORMSQ = "00000"  AND  NORMSQ NOT = SQLSTATE)
             then
               DISPLAY "Valid implementation-defined SQLSTATE accepted."
             END-IF
             .

       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 NORMSQ

           MOVE 3 TO norm1
      *subclass begins in position 3 of char array NORMSQ
      *valid subclass begins with 5-9, I-Z, end of ALPNUM table
           PERFORM VARYING norm2 FROM 14 BY 1 UNTIL norm2 > 36
           if (NORMSQX(norm1)  =  ALPNUM(norm2)) then
             MOVE "0" TO NORMSQX(norm1)
           END-IF
           END-PERFORM

      *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)
           if (NORMSQ   =   SQLSTATE) then
             GO TO EXIT-NOSUBCLASS
           END-IF

           MOVE 4 TO norm1
      *examining position 4 of char array NORMSQ
      *valid characters are 0-9, A-Z
           PERFORM VARYING norm2 FROM 1 BY 1 UNTIL norm2 > 36
           if (NORMSQX(norm1)  =  ALPNUM(norm2)) then
             MOVE "0" TO NORMSQX(norm1)
           END-IF
           END-PERFORM

           MOVE 5 TO norm1
      *valid characters are 0-9, A-Z
      *examining position 5 of char array NORMSQ
           PERFORM VARYING norm2 FROM 1 BY 1 UNTIL norm2 > 36
           if (NORMSQX(norm1)  =  ALPNUM(norm2)) then
             MOVE "0" TO NORMSQX(norm1)
           END-IF
           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 (NORMSQX(1)  =  "0"  AND  NORMSQX(2)  =  "1") then
             MOVE "0" TO NORMSQX(2)
           END-IF
           .

       EXIT-NOSUBCLASS.
           EXIT.

quality100%

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