Quelle dml107.cob
Sprache: Cobol
IDENTIFICATION DIVISION .
PROGRAM-ID . DML107.
ENVIRONMENT DIVISION .
CONFIGURATION SECTION .
SOURCE-COMPUTER . xyz.
OBJECT-COMPUTER . xyz.
DATA DIVISION .
WORKING-STORAGE SECTION .
* Standard COBOL (file "DML107.SCO") calling SQL
* procedures in file "DML107.MCO".
****************************************************************
*
* COMMENT SECTION
*
* DATE 1993/08/20 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.
*
* DML107.SCO
* WRITTEN BY: David W. Flater
* TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE
*
* This routine tests several FIPS features in Transitional
* SQL. This is the dynamic version of DML106.
*
* REFERENCES
* FIPS PUB 127-2 14.1 Transitional SQL
* ANSI SQL-1992
*
****************************************************************
* 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 int1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE .
01 int2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE .
01 dstmt PIC X(50).
01 longst PIC X(240).
* EXEC SQL END DECLARE SECTION END-EXEC
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, dml107.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 TEST0600 *******************
MOVE 1 TO flag
DISPLAY " TEST0600 "
DISPLAY " UNION in views (feature 8) (dynamic)"
DISPLAY "References:"
DISPLAY " FIPS PUB 127-2 14.1 Transitional SQL feature
- " 8"
DISPLAY " ANSI SQL-1992 11.19 <view definition>"
DISPLAY " - - - - - - - - - - - - - - - - - - -"
COMPUTE SQLCODE = -1
MOVE "xxxxx" TO SQLSTATE
* EXEC SQL DELETE FROM CONCATBUF;
CALL "SUB3" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO CONCATBUF VALUES (
* 'CREATE VIEW UUSIG (U1) AS ' ||
* ' SELECT C1 FROM USIG UNION SELECT C_1 FROM USIG'
* );
CALL "SUB4" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF;
CALL "SUB5" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
DISPLAY "longst=" "" , longst "" ""
DISPLAY "COMMIT WORK;"
* EXEC SQL COMMIT WORK;
CALL "SUB6" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "EXECUTE IMMEDIATE :longst;"
* EXEC SQL EXECUTE IMMEDIATE :longst;
CALL "SUB7" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "COMMIT WORK;"
* EXEC SQL COMMIT WORK;
CALL "SUB8" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "dstmt=" "SELECT COUNT(*) FROM UUSIG" ""
MOVE "SELECT COUNT(*) FROM UUSIG
- " " TO dstmt
DISPLAY "PREPARE S10711 FROM :dstmt;"
* EXEC SQL PREPARE S10711 FROM :dstmt;
CALL "SUB9" USING SQLCODE SQLSTATE dstmt
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "DECLARE C10711 CURSOR FOR S10711;"
* EXEC SQL DECLARE C10711 CURSOR FOR S10711 END-EXEC
DISPLAY " "
DISPLAY "OPEN C10711;"
* EXEC SQL OPEN C10711;
CALL "SUB10" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
COMPUTE int1 = -1
DISPLAY "FETCH C10711 INTO :int1;"
* EXEC SQL FETCH C10711 INTO :int1;
CALL "SUB11" USING SQLCODE SQLSTATE int1
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "int1 should be 4; its value is " , int1
if (int1 NOT = 4) then
MOVE 0 TO flag
END-IF
DISPLAY "CLOSE C10711;"
* EXEC SQL CLOSE C10711;
CALL "SUB12" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "dstmt=" "SELECT COUNT(DISTINCT U1) FROM UUSIG" ""
MOVE "SELECT COUNT(DISTINCT U1) FROM UUSIG "
TO dstmt
DISPLAY "PREPARE S10712 FROM :dstmt;"
* EXEC SQL PREPARE S10712 FROM :dstmt;
CALL "SUB13" USING SQLCODE SQLSTATE dstmt
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "DECLARE C10712 CURSOR FOR S10712;"
* EXEC SQL DECLARE C10712 CURSOR FOR S10712 END-EXEC
DISPLAY " "
DISPLAY "OPEN C10712;"
* EXEC SQL OPEN C10712;
CALL "SUB14" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
COMPUTE int1 = -1
DISPLAY "FETCH C10712 INTO :int1;"
* EXEC SQL FETCH C10712 INTO :int1;
CALL "SUB15" USING SQLCODE SQLSTATE int1
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "int1 should be 4; its value is " , int1
if (int1 NOT = 4) then
MOVE 0 TO flag
END-IF
DISPLAY "CLOSE C10712;"
* EXEC SQL CLOSE C10712;
CALL "SUB16" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
* EXEC SQL DELETE FROM CONCATBUF;
CALL "SUB17" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO CONCATBUF VALUES (
* 'SELECT COUNT(*) FROM UUSIG WHERE U1 < 0 OR ' ||
* ' U1 > 3 OR U1 IS NULL'
* );
CALL "SUB18" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF;
CALL "SUB19" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
DISPLAY "longst=" "" , longst "" ""
DISPLAY "PREPARE S10713 FROM :longst;"
* EXEC SQL PREPARE S10713 FROM :longst;
CALL "SUB20" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "DECLARE C10713 CURSOR FOR S10713;"
* EXEC SQL DECLARE C10713 CURSOR FOR S10713 END-EXEC
DISPLAY " "
DISPLAY "OPEN C10713;"
* EXEC SQL OPEN C10713;
CALL "SUB21" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
COMPUTE int1 = -1
DISPLAY "FETCH C10713 INTO :int1;"
* EXEC SQL FETCH C10713 INTO :int1;
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
DISPLAY "CLOSE C10713;"
* EXEC SQL CLOSE C10713;
CALL "SUB23" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "ROLLBACK WORK;"
* EXEC SQL ROLLBACK WORK;
CALL "SUB24" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "dstmt=" "DROP VIEW UUSIG CASCADE" ""
MOVE "DROP VIEW UUSIG CASCADE "
TO dstmt
DISPLAY "EXECUTE IMMEDIATE :dstmt;"
* EXEC SQL EXECUTE IMMEDIATE :dstmt;
CALL "SUB25" USING SQLCODE SQLSTATE dstmt
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "COMMIT WORK;"
* EXEC SQL COMMIT WORK;
CALL "SUB26" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
if ( flag = 1 ) then
DISPLAY " *** pass *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0600','pass','MCO');
CALL "SUB27" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " dml107.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0600','fail','MCO');
CALL "SUB28" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB29" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
******************** END TEST0600 ********************
******************** BEGIN TEST0602 *******************
MOVE 1 TO flag
DISPLAY " TEST0602 "
DISPLAY " DATETIME data types (feature 5) (dynamic)"
DISPLAY "References:"
DISPLAY " FIPS PUB 127-2 14.1 Transitional SQL feature
- " 5"
DISPLAY " ANSI SQL-1992 6.1 <data type>"
DISPLAY " - - - - - - - - - - - - - - - - - - -"
COMPUTE SQLCODE = -1
MOVE "xxxxx" TO SQLSTATE
* EXEC SQL DELETE FROM CONCATBUF;
CALL "SUB30" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO CONCATBUF VALUES (
* 'CREATE TABLE TEMPUS (TDATE DATE, TTIME TIME,'||
* ' TTIMESTAMP TIMESTAMP, TINT1 INTERVAL YEAR'||
* ' TO MONTH, TINT2 INTERVAL DAY TO SECOND)'
* );
CALL "SUB31" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF;
CALL "SUB32" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
DISPLAY "longst=" "" , longst "" ""
DISPLAY "COMMIT WORK;"
* EXEC SQL COMMIT WORK;
CALL "SUB33" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "EXECUTE IMMEDIATE :longst;"
* EXEC SQL EXECUTE IMMEDIATE :longst;
CALL "SUB34" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "COMMIT WORK;"
* EXEC SQL COMMIT WORK;
CALL "SUB35" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
* EXEC SQL DELETE FROM CONCATBUF;
CALL "SUB36" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO CONCATBUF VALUES (
* 'INSERT INTO TEMPUS VALUES (' ||
* ' DATE ''1993-08-24'',' ||
* ' TIME ''16:03:00'',' ||
* ' TIMESTAMP ''1993-08-24 16:03:00'',' ||
* ' INTERVAL -''1-6'' YEAR TO MONTH,' ||
* ' INTERVAL ''13 0:10'' DAY TO SECOND)'
* );
CALL "SUB37" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF;
CALL "SUB38" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
DISPLAY "longst=" "" , longst "" ""
DISPLAY "EXECUTE IMMEDIATE :longst;"
* EXEC SQL EXECUTE IMMEDIATE :longst;
CALL "SUB39" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "dstmt=" "SELECT EXTRACT (DAY FROM TDATE) FROM
- " TEMPUS" ""
MOVE "SELECT EXTRACT (DAY FROM TDATE) FROM TEMPUS "
TO dstmt
DISPLAY "PREPARE S10721 FROM :dstmt;"
* EXEC SQL PREPARE S10721 FROM :dstmt;
CALL "SUB40" USING SQLCODE SQLSTATE dstmt
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "DECLARE C10721 CURSOR FOR S10721;"
* EXEC SQL DECLARE C10721 CURSOR FOR S10721 END-EXEC
DISPLAY " "
DISPLAY "OPEN C10721;"
* EXEC SQL OPEN C10721;
CALL "SUB41" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
COMPUTE int1 = -1
DISPLAY "FETCH C10721 INTO :int1;"
* EXEC SQL FETCH C10721 INTO :int1;
CALL "SUB42" USING SQLCODE SQLSTATE int1
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "int1 should be 24; its value is " , int1
if (int1 NOT = 24) then
MOVE 0 TO flag
END-IF
DISPLAY "CLOSE C10721;"
* EXEC SQL CLOSE C10721;
CALL "SUB43" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
* EXEC SQL DELETE FROM CONCATBUF;
CALL "SUB44" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO CONCATBUF VALUES (
* 'SELECT COUNT(*) FROM TEMPUS ' ||
* ' WHERE (TTIMESTAMP - TIMESTAMP'||
* ' ''1995-02-24 16:03:00'')'||
* ' YEAR TO MONTH = TINT1'
* );
CALL "SUB45" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF;
CALL "SUB46" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
DISPLAY "longst=" "" , longst "" ""
DISPLAY "PREPARE S10722 FROM :longst;"
* EXEC SQL PREPARE S10722 FROM :longst;
CALL "SUB47" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "DECLARE C10722 CURSOR FOR S10722;"
* EXEC SQL DECLARE C10722 CURSOR FOR S10722 END-EXEC
DISPLAY " "
DISPLAY "OPEN C10722;"
* EXEC SQL OPEN C10722;
CALL "SUB48" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
COMPUTE int1 = -1
DISPLAY "FETCH C10722 INTO :int1;"
* EXEC SQL FETCH C10722 INTO :int1;
CALL "SUB49" 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
DISPLAY "CLOSE C10722;"
* EXEC SQL CLOSE C10722;
CALL "SUB50" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
*Overlaps TEd hook #1
* EXEC SQL DELETE FROM CONCATBUF;
CALL "SUB51" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO CONCATBUF VALUES (
* 'SELECT COUNT(*) FROM TEMPUS ' ||
* ' WHERE (TTIMESTAMP, TINT1) OVERLAPS ' ||
* ' (TIMESTAMP ''1995-02-24 16:03:00'', ' ||
* ' INTERVAL ''1-6'' YEAR TO MONTH)'
* );
CALL "SUB52" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF;
CALL "SUB53" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
DISPLAY "longst=" "" , longst "" ""
DISPLAY "PREPARE S10723 FROM :longst;"
* EXEC SQL PREPARE S10723 FROM :longst;
CALL "SUB54" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "DECLARE C10723 CURSOR FOR S10723;"
* EXEC SQL DECLARE C10723 CURSOR FOR S10723 END-EXEC
DISPLAY " "
DISPLAY "OPEN C10723;"
* EXEC SQL OPEN C10723;
CALL "SUB55" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
COMPUTE int1 = -1
DISPLAY "FETCH C10723 INTO :int1;"
* EXEC SQL FETCH C10723 INTO :int1;
CALL "SUB56" 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
DISPLAY "CLOSE C10723;"
* EXEC SQL CLOSE C10723;
CALL "SUB57" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
*Overlaps TEd hook #2
DISPLAY "ROLLBACK WORK;"
* EXEC SQL ROLLBACK WORK;
CALL "SUB58" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "dstmt=" "DROP TABLE TEMPUS CASCADE" ""
MOVE "DROP TABLE TEMPUS CASCADE "
TO dstmt
DISPLAY "EXECUTE IMMEDIATE :dstmt;"
* EXEC SQL EXECUTE IMMEDIATE :dstmt;
CALL "SUB59" USING SQLCODE SQLSTATE dstmt
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "COMMIT WORK;"
* EXEC SQL COMMIT WORK;
CALL "SUB60" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
if ( flag = 1 ) then
DISPLAY " *** pass *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0602','pass','MCO');
CALL "SUB61" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " dml107.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0602','fail','MCO');
CALL "SUB62" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB63" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
******************** END TEST0602 ********************
******************** BEGIN TEST0612 *******************
MOVE 1 TO flag
DISPLAY " TEST0612 "
DISPLAY " FIPS sizing, DATETIME data types (dynamic)"
DISPLAY "References:"
DISPLAY " FIPS PUB 127-2 14.1 Transitional SQL feature
- " 5"
DISPLAY " ANSI SQL-1992 6.1 <data type> SR.25-26"
DISPLAY " LR.1.a"
DISPLAY " 10.1 <interval qualifier> SR 3&4"
DISPLAY " - - - - - - - - - - - - - - - - - - -"
COMPUTE SQLCODE = -1
MOVE "xxxxx" TO SQLSTATE
*6.1 LR.1.a denies us the right to use <time precision> or
*<timestamp precision> in the declaration. SR.25 says that
*<time precision> defaults to 0 and <timestamp precision>
*defaults to 6.
* EXEC SQL DELETE FROM CONCATBUF;
CALL "SUB64" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO CONCATBUF VALUES (
* 'CREATE TABLE TSFIPS (' ||
* ' FIPS1 TIME,' ||
* ' FIPS2 TIMESTAMP,' ||
* ' FIPS3 INTERVAL YEAR (2) TO MONTH,' ||
* ' FIPS4 INTERVAL DAY (2) TO SECOND (6))'
* );
CALL "SUB65" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF;
CALL "SUB66" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
DISPLAY "longst=" "" , longst "" ""
DISPLAY "COMMIT WORK;"
* EXEC SQL COMMIT WORK;
CALL "SUB67" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "EXECUTE IMMEDIATE :longst;"
* EXEC SQL EXECUTE IMMEDIATE :longst;
CALL "SUB68" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "COMMIT WORK;"
* EXEC SQL COMMIT WORK;
CALL "SUB69" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
* EXEC SQL DELETE FROM CONCATBUF;
CALL "SUB70" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO CONCATBUF VALUES (
* 'INSERT INTO TSFIPS VALUES (' ||
* ' TIME ''16:03:00'',' ||
* ' TIMESTAMP ''1996-08-24 16:03:00.999999'',' ||
* ' INTERVAL -''99-6'' YEAR (2) TO MONTH,' ||
* ' INTERVAL ''99 0:10:00.999999'' DAY (2) TO SECOND (6))'
* );
CALL "SUB71" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF;
CALL "SUB72" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
DISPLAY "longst=" "" , longst "" ""
DISPLAY "EXECUTE IMMEDIATE :longst;"
* EXEC SQL EXECUTE IMMEDIATE :longst;
CALL "SUB73" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
* EXEC SQL DELETE FROM CONCATBUF;
CALL "SUB74" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO CONCATBUF VALUES (
* 'SELECT EXTRACT (SECOND FROM FIPS2)' ||
* ' * 1000000 - 999990 FROM TSFIPS'
* );
CALL "SUB75" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF;
CALL "SUB76" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
DISPLAY "longst=" "" , longst "" ""
DISPLAY "PREPARE S10732 FROM :longst;"
* EXEC SQL PREPARE S10732 FROM :longst;
CALL "SUB77" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "DECLARE C10732 CURSOR FOR S10732;"
* EXEC SQL DECLARE C10732 CURSOR FOR S10732 END-EXEC
DISPLAY " "
DISPLAY "OPEN C10732;"
* EXEC SQL OPEN C10732;
CALL "SUB78" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
COMPUTE int1 = -1
DISPLAY "FETCH C10732 INTO :int1;"
* EXEC SQL FETCH C10732 INTO :int1;
CALL "SUB79" USING SQLCODE SQLSTATE int1
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "int1 should be 9; its value is " , int1
if (int1 NOT = 9) then
MOVE 0 TO flag
END-IF
DISPLAY "CLOSE C10732;"
* EXEC SQL CLOSE C10732;
CALL "SUB80" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
* EXEC SQL DELETE FROM CONCATBUF;
CALL "SUB81" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO CONCATBUF VALUES (
* 'SELECT EXTRACT (YEAR FROM FIPS3),' ||
* ' EXTRACT (MONTH FROM FIPS3) FROM TSFIPS'
* );
CALL "SUB82" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF;
CALL "SUB83" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
DISPLAY "longst=" "" , longst "" ""
DISPLAY "PREPARE S10733 FROM :longst;"
* EXEC SQL PREPARE S10733 FROM :longst;
CALL "SUB84" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "DECLARE C10733 CURSOR FOR S10733;"
* EXEC SQL DECLARE C10733 CURSOR FOR S10733 END-EXEC
DISPLAY " "
DISPLAY "OPEN C10733;"
* EXEC SQL OPEN C10733;
CALL "SUB85" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
COMPUTE int1 = -1
COMPUTE int2 = -1
DISPLAY "FETCH C10733 INTO :int1, :int2;"
* EXEC SQL FETCH C10733 INTO :int1, :int2;
CALL "SUB86" USING SQLCODE SQLSTATE int1 int2
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "int1 should be -99; its value is " , int1
DISPLAY "int2 should be -6; its value is " , int2
DISPLAY "Note: The sign is specified by Subclause 6.6
- " GR.3.1"
DISPLAY " in ANSI SQL-1992."
if (int1 NOT = -99 OR int2 NOT = -6) then
MOVE 0 TO flag
END-IF
DISPLAY "CLOSE C10733;"
* EXEC SQL CLOSE C10733;
CALL "SUB87" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
* EXEC SQL DELETE FROM CONCATBUF;
CALL "SUB88" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO CONCATBUF VALUES (
* 'SELECT EXTRACT (DAY FROM FIPS4),' ||
* ' EXTRACT (SECOND FROM FIPS4)' ||
* ' * 1000000 - 999990 FROM TSFIPS'
* );
CALL "SUB89" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF;
CALL "SUB90" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
DISPLAY "longst=" "" , longst "" ""
DISPLAY "PREPARE S10734 FROM :longst;"
* EXEC SQL PREPARE S10734 FROM :longst;
CALL "SUB91" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "DECLARE C10734 CURSOR FOR S10734;"
* EXEC SQL DECLARE C10734 CURSOR FOR S10734 END-EXEC
DISPLAY " "
DISPLAY "OPEN C10734;"
* EXEC SQL OPEN C10734;
CALL "SUB92" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
COMPUTE int1 = -1
COMPUTE int2 = -1
DISPLAY "FETCH C10734 INTO :int1, :int2;"
* EXEC SQL FETCH C10734 INTO :int1, :int2;
CALL "SUB93" USING SQLCODE SQLSTATE int1 int2
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY "int1 should be 99; its value is " , int1
DISPLAY "int2 should be 9; its value is " , int2
if (int1 NOT = 99 OR int2 NOT = 9) then
MOVE 0 TO flag
END-IF
DISPLAY "CLOSE C10734;"
* EXEC SQL CLOSE C10734;
CALL "SUB94" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "ROLLBACK WORK;"
* EXEC SQL ROLLBACK WORK;
CALL "SUB95" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "dstmt=" "DROP TABLE TSFIPS CASCADE" ""
MOVE "DROP TABLE TSFIPS CASCADE "
TO dstmt
DISPLAY "EXECUTE IMMEDIATE :dstmt;"
* EXEC SQL EXECUTE IMMEDIATE :dstmt;
CALL "SUB96" USING SQLCODE SQLSTATE dstmt
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "COMMIT WORK;"
* EXEC SQL COMMIT WORK;
CALL "SUB97" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
if ( flag = 1 ) then
DISPLAY " *** pass *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0612','pass','MCO');
CALL "SUB98" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " dml107.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0612','fail','MCO');
CALL "SUB99" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB100" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
******************** END TEST0612 ********************
******************** BEGIN TEST0614 *******************
MOVE 1 TO flag
DISPLAY " TEST0614 "
DISPLAY " <datetime value function> (dynamic)"
DISPLAY "References:"
DISPLAY " FIPS PUB 127-2 14.1 Transitional SQL features
- " 5, 20"
DISPLAY " ANSI SQL-1992 6.8 <datetime value function>"
DISPLAY " 6.8 GR.3"
DISPLAY " - - - - - - - - - - - - - - - - - - -"
COMPUTE SQLCODE = -1
MOVE "xxxxx" TO SQLSTATE
*Support for timezones is not included in Transitional SQL
* EXEC SQL DELETE FROM CONCATBUF;
CALL "SUB101" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO CONCATBUF VALUES (
* 'CREATE TABLE TSSMALL (' ||
* ' SMALLD DATE,' ||
* ' SMALLT TIME,' ||
* ' SMALLTS TIMESTAMP)'
* );
CALL "SUB102" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF;
CALL "SUB103" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
DISPLAY "longst=" "" , longst "" ""
DISPLAY "COMMIT WORK;"
* EXEC SQL COMMIT WORK;
CALL "SUB104" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "EXECUTE IMMEDIATE :longst;"
* EXEC SQL EXECUTE IMMEDIATE :longst;
CALL "SUB105" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "COMMIT WORK;"
* EXEC SQL COMMIT WORK;
CALL "SUB106" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
* EXEC SQL DELETE FROM CONCATBUF;
CALL "SUB107" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO CONCATBUF VALUES (
* 'INSERT INTO TSSMALL VALUES (' ||
* ' CURRENT_DATE, CURRENT_TIME, CURRENT_TIMESTAMP)'
* );
CALL "SUB108" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF;
CALL "SUB109" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
DISPLAY "longst=" "" , longst "" ""
DISPLAY "EXECUTE IMMEDIATE :longst;"
* EXEC SQL EXECUTE IMMEDIATE :longst;
CALL "SUB110" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
* EXEC SQL DELETE FROM CONCATBUF;
CALL "SUB111" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO CONCATBUF VALUES (
* 'SELECT COUNT(*) FROM TSSMALL WHERE' ||
* ' EXTRACT (YEAR FROM SMALLD) = EXTRACT'||
* ' (YEAR FROM SMALLTS)'
* );
CALL "SUB112" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF;
CALL "SUB113" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
DISPLAY "longst=" "" , longst "" ""
DISPLAY "PREPARE S10741 FROM :longst;"
* EXEC SQL PREPARE S10741 FROM :longst;
CALL "SUB114" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "DECLARE C10741 CURSOR FOR S10741;"
* EXEC SQL DECLARE C10741 CURSOR FOR S10741 END-EXEC
DISPLAY " "
DISPLAY "OPEN C10741;"
* EXEC SQL OPEN C10741;
CALL "SUB115" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
COMPUTE int1 = -1
DISPLAY "FETCH C10741 INTO :int1;"
* EXEC SQL FETCH C10741 INTO :int1;
CALL "SUB116" 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
DISPLAY "CLOSE C10741;"
* EXEC SQL CLOSE C10741;
CALL "SUB117" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
* EXEC SQL DELETE FROM CONCATBUF;
CALL "SUB118" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO CONCATBUF VALUES (
* 'SELECT COUNT(*) FROM TSSMALL WHERE' ||
* ' EXTRACT (MONTH FROM SMALLD) = EXTRACT'||
* ' (MONTH FROM SMALLTS)'
* );
CALL "SUB119" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF;
CALL "SUB120" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
DISPLAY "longst=" "" , longst "" ""
DISPLAY "PREPARE S10742 FROM :longst;"
* EXEC SQL PREPARE S10742 FROM :longst;
CALL "SUB121" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "DECLARE C10742 CURSOR FOR S10742;"
* EXEC SQL DECLARE C10742 CURSOR FOR S10742 END-EXEC
DISPLAY " "
DISPLAY "OPEN C10742;"
* EXEC SQL OPEN C10742;
CALL "SUB122" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
COMPUTE int1 = -1
DISPLAY "FETCH C10742 INTO :int1;"
* EXEC SQL FETCH C10742 INTO :int1;
CALL "SUB123" 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
DISPLAY "CLOSE C10742;"
* EXEC SQL CLOSE C10742;
CALL "SUB124" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
* EXEC SQL DELETE FROM CONCATBUF;
CALL "SUB125" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO CONCATBUF VALUES (
* 'SELECT COUNT(*) FROM TSSMALL WHERE' ||
* ' EXTRACT (DAY FROM SMALLD) = EXTRACT'||
* ' (DAY FROM SMALLTS)'
* );
CALL "SUB126" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF;
CALL "SUB127" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
DISPLAY "longst=" "" , longst "" ""
DISPLAY "PREPARE S10743 FROM :longst;"
* EXEC SQL PREPARE S10743 FROM :longst;
CALL "SUB128" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "DECLARE C10743 CURSOR FOR S10743;"
* EXEC SQL DECLARE C10743 CURSOR FOR S10743 END-EXEC
DISPLAY " "
DISPLAY "OPEN C10743;"
* EXEC SQL OPEN C10743;
CALL "SUB129" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
COMPUTE int1 = -1
DISPLAY "FETCH C10743 INTO :int1;"
* EXEC SQL FETCH C10743 INTO :int1;
CALL "SUB130" 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
DISPLAY "CLOSE C10743;"
* EXEC SQL CLOSE C10743;
CALL "SUB131" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
* EXEC SQL DELETE FROM CONCATBUF;
CALL "SUB132" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO CONCATBUF VALUES (
* 'SELECT COUNT(*) FROM TSSMALL WHERE' ||
* ' EXTRACT (HOUR FROM SMALLT) = EXTRACT'||
* ' (HOUR FROM SMALLTS)'
* );
CALL "SUB133" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF;
CALL "SUB134" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
DISPLAY "longst=" "" , longst "" ""
DISPLAY "PREPARE S10744 FROM :longst;"
* EXEC SQL PREPARE S10744 FROM :longst;
CALL "SUB135" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "DECLARE C10744 CURSOR FOR S10744;"
* EXEC SQL DECLARE C10744 CURSOR FOR S10744 END-EXEC
DISPLAY " "
DISPLAY "OPEN C10744;"
* EXEC SQL OPEN C10744;
CALL "SUB136" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
COMPUTE int1 = -1
DISPLAY "FETCH C10744 INTO :int1;"
* EXEC SQL FETCH C10744 INTO :int1;
CALL "SUB137" 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
DISPLAY "CLOSE C10744;"
* EXEC SQL CLOSE C10744;
CALL "SUB138" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
* EXEC SQL DELETE FROM CONCATBUF;
CALL "SUB139" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO CONCATBUF VALUES (
* 'SELECT COUNT(*) FROM TSSMALL WHERE' ||
* ' EXTRACT (MINUTE FROM SMALLT) = EXTRACT' ||
* ' (MINUTE FROM SMALLTS)'
* );
CALL "SUB140" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF;
CALL "SUB141" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
DISPLAY "longst=" "" , longst "" ""
DISPLAY "PREPARE S10745 FROM :longst;"
* EXEC SQL PREPARE S10745 FROM :longst;
CALL "SUB142" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "DECLARE C10745 CURSOR FOR S10745;"
* EXEC SQL DECLARE C10745 CURSOR FOR S10745 END-EXEC
DISPLAY " "
DISPLAY "OPEN C10745;"
* EXEC SQL OPEN C10745;
CALL "SUB143" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
COMPUTE int1 = -1
DISPLAY "FETCH C10745 INTO :int1;"
* EXEC SQL FETCH C10745 INTO :int1;
CALL "SUB144" 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
DISPLAY "CLOSE C10745;"
* EXEC SQL CLOSE C10745;
CALL "SUB145" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
* EXEC SQL DELETE FROM CONCATBUF;
CALL "SUB146" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO CONCATBUF VALUES (
* 'SELECT COUNT(*)' ||
* ' FROM TSSMALL WHERE' ||
* ' EXTRACT (SECOND FROM SMALLT) -' ||
* ' EXTRACT (SECOND FROM SMALLTS) > -1' ||
* ' AND EXTRACT (SECOND FROM SMALLT) -' ||
* ' EXTRACT (SECOND FROM SMALLTS) < 1'
* );
CALL "SUB147" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF;
CALL "SUB148" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
DISPLAY "longst=" "" , longst "" ""
DISPLAY "PREPARE S10746 FROM :longst;"
* EXEC SQL PREPARE S10746 FROM :longst;
CALL "SUB149" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "DECLARE C10746 CURSOR FOR S10746;"
* EXEC SQL DECLARE C10746 CURSOR FOR S10746 END-EXEC
DISPLAY " "
DISPLAY "OPEN C10746;"
* EXEC SQL OPEN C10746;
CALL "SUB150" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
COMPUTE int1 = -1
DISPLAY "FETCH C10746 INTO :int1;"
* EXEC SQL FETCH C10746 INTO :int1;
CALL "SUB151" 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
DISPLAY "CLOSE C10746;"
* EXEC SQL CLOSE C10746;
CALL "SUB152" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "ROLLBACK WORK;"
* EXEC SQL ROLLBACK WORK;
CALL "SUB153" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "dstmt=" "DROP TABLE TSSMALL CASCADE" ""
MOVE "DROP TABLE TSSMALL CASCADE "
TO dstmt
DISPLAY "EXECUTE IMMEDIATE :dstmt;"
* EXEC SQL EXECUTE IMMEDIATE :dstmt;
CALL "SUB154" USING SQLCODE SQLSTATE dstmt
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "COMMIT WORK;"
* EXEC SQL COMMIT WORK;
CALL "SUB155" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
if ( flag = 1 ) then
DISPLAY " *** pass *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0614','pass','MCO');
CALL "SUB156" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " dml107.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0614','fail','MCO');
CALL "SUB157" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB158" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
******************** END TEST0614 ********************
******************** BEGIN TEST0616 *******************
MOVE 1 TO flag
DISPLAY " TEST0616 "
DISPLAY " DATETIME-related SQLSTATE codes (dynamic)"
DISPLAY "References:"
DISPLAY " FIPS PUB 127-2 14.1 Transitional SQL features
- " 1, 5, 20"
DISPLAY " ANSI SQL-1992 22.1 SQLSTATE"
DISPLAY " 6.14 GR.3.c"
DISPLAY " 9.2 GR.3.m"
DISPLAY " COR1 for 6.10 GR.9.a.ii GR.10.a.ii GR.11.a.ii"
DISPLAY " - - - - - - - - - - - - - - - - - - -"
COMPUTE SQLCODE = -1
MOVE "xxxxx" TO SQLSTATE
*Datetime field overflow = 22008: add a one-year interval to
* YEAR 9999 datetime (6.14 GR.3.c)
*Interval field overflow = 22015: insert interval with too
* many digits in leading field (9.2 GR.3.m)
*Invalid datetime format = 22007: cast February 30 to datetime
* (COR1 for 6.10 GR 9.a.ii, 10.a.ii, 11.a.ii)
* EXEC SQL DELETE FROM CONCATBUF;
CALL "SUB159" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO CONCATBUF VALUES (
* 'CREATE TABLE TSERR (' ||
* ' BADINT INTERVAL YEAR (2) TO MONTH,' ||
* ' BADDATE DATE)'
* );
CALL "SUB160" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF;
CALL "SUB161" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
DISPLAY "longst=" "" , longst "" ""
DISPLAY "COMMIT WORK;"
* EXEC SQL COMMIT WORK;
CALL "SUB162" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "EXECUTE IMMEDIATE :longst;"
* EXEC SQL EXECUTE IMMEDIATE :longst;
CALL "SUB163" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "COMMIT WORK;"
* EXEC SQL COMMIT WORK;
CALL "SUB164" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
* NOTICE
*The Standard is very clear on the fact that the YEAR
*field can't accept values below 1 or above 9999 in
*datetime items (see Table 10 and 6.14 GR.3.c).
*However, since it seems to us that a reasonable
*human being might want to implement YEAR with a
*small integer and permit the larger range to be used,
*you may replace the 9999 in the date literal below
*with as large an integer as you require to generate
*the specified error condition. This offer is null
*and void if the range limitation on YEAR is upheld by
*an official interpretation.
*DML107 TEd Hook #1
* EXEC SQL DELETE FROM CONCATBUF;
CALL "SUB165" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO CONCATBUF VALUES (
* 'INSERT INTO TSERR VALUES (' ||
* ' INTERVAL ''0-11'' YEAR TO MONTH,' ||
* ' DATE ''9999-01-01'' + INTERVAL ''1-00'''||
* ' YEAR TO MONTH)'
* );
CALL "SUB166" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF;
CALL "SUB167" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
DISPLAY "longst=" "" , longst "" ""
DISPLAY "EXECUTE IMMEDIATE :longst;"
* EXEC SQL EXECUTE IMMEDIATE :longst;
CALL "SUB168" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
*DML107 TEd Hook #2
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 22008; its value is " , SQLSTATE
if (SQLSTATE NOT = "22008" ) then
MOVE 0 TO flag
END-IF
* EXEC SQL DELETE FROM CONCATBUF;
CALL "SUB169" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO CONCATBUF VALUES (
* 'INSERT INTO TSERR VALUES (' ||
* ' INTERVAL ''9999-11'' YEAR TO MONTH,' ||
* ' DATE ''1984-01-01'')'
* );
CALL "SUB170" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF;
CALL "SUB171" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
DISPLAY "longst=" "" , longst "" ""
DISPLAY "EXECUTE IMMEDIATE :longst;"
* EXEC SQL EXECUTE IMMEDIATE :longst;
CALL "SUB172" USING SQLCODE SQLSTATE longst
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 22015; its value is " , SQLSTATE
if (SQLSTATE NOT = "22015" ) then
MOVE 0 TO flag
END-IF
* EXEC SQL DELETE FROM CONCATBUF;
CALL "SUB173" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO CONCATBUF VALUES (
* 'INSERT INTO TSERR VALUES (' ||
* ' INTERVAL ''1-11'' YEAR TO MONTH,' ||
* ' CAST (''DATE ''''1993-02-30'''''' AS DATE))'
* );
CALL "SUB174" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF;
CALL "SUB175" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
DISPLAY "longst=" "" , longst "" ""
DISPLAY "EXECUTE IMMEDIATE :longst;"
* EXEC SQL EXECUTE IMMEDIATE :longst;
CALL "SUB176" USING SQLCODE SQLSTATE longst
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 22007; its value is " , SQLSTATE
if (SQLSTATE NOT = "22007" ) then
MOVE 0 TO flag
END-IF
*The above could be passed for the wrong reason if the uglified
*syntax is not supported. Repeat with shorter syntax.
* EXEC SQL DELETE FROM CONCATBUF;
CALL "SUB177" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO CONCATBUF VALUES (
* 'INSERT INTO TSERR VALUES (' ||
* ' INTERVAL ''1-11'' YEAR TO MONTH,' ||
* ' CAST (''1993-02-30'' AS DATE))'
* );
CALL "SUB178" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
* EXEC SQL SELECT ZZ INTO :longst FROM CONCATBUF;
CALL "SUB179" USING SQLCODE SQLSTATE longst
MOVE SQLCODE TO SQL-COD
DISPLAY "longst=" "" , longst "" ""
DISPLAY "EXECUTE IMMEDIATE :longst;"
* EXEC SQL EXECUTE IMMEDIATE :longst;
CALL "SUB180" USING SQLCODE SQLSTATE longst
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 22007; its value is " , SQLSTATE
if (SQLSTATE NOT = "22007" ) then
MOVE 0 TO flag
END-IF
DISPLAY "ROLLBACK WORK;"
* EXEC SQL ROLLBACK WORK;
CALL "SUB181" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "dstmt=" "DROP TABLE TSERR CASCADE" ""
MOVE "DROP TABLE TSERR CASCADE "
TO dstmt
DISPLAY "EXECUTE IMMEDIATE :dstmt;"
* EXEC SQL EXECUTE IMMEDIATE :dstmt;
CALL "SUB182" USING SQLCODE SQLSTATE dstmt
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
DISPLAY "COMMIT WORK;"
* EXEC SQL COMMIT WORK;
CALL "SUB183" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
PERFORM CHCKOK
DISPLAY " "
if ( flag = 1 ) then
DISPLAY " *** pass *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0616','pass','MCO');
CALL "SUB184" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " dml107.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0616','fail','MCO');
CALL "SUB185" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB186" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
******************** END TEST0616 ********************
**** 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 .
Messung V0.5 in Prozent C=76 H=100 G=88
¤ Dauer der Verarbeitung: 0.30 Sekunden
(vorverarbeitet am 2026-04-30)
¤
*© Formatika GbR, Deutschland
2026-05-26