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