|
IDENTIFICATION DIVISION.
PROGRAM-ID. DML055.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. xyz.
OBJECT-COMPUTER. xyz.
DATA DIVISION.
WORKING-STORAGE SECTION.
* Standard COBOL (file "DML055.SCO") calling SQL
* procedures in file "DML055.MCO"
****************************************************************
*
* COMMENT SECTION
*
* DATE 1988/02/10 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.
*
* DML055.SCO
* WRITTEN BY: SUN DAJUN
* TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE
*
* THIS ROUTINE TESTS THE LIMIT ON THE PRECISION OF VARIOUS
* DATA TYPES.
*
* REFERENCES
* AMERICAN NATIONAL STANDARD database language - SQL
* X3.135-1989
*
* FIPS PUB 127-1, Section 13.5
* Sizing for database constructs
*
*
****************************************************************
* EXEC SQL BEGIN DECLARE SECTION END-EXEC
01 count1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 count2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 float1 PIC S9V9(15) USAGE DISPLAY SIGN LEADING SEPARATE.
01 float2 PIC S9V9(15) USAGE IS DISPLAY SIGN LEADING SEPARATE.
* EXEC SQL END DECLARE SECTION END-EXEC
01 SQLCODE PIC S9(9) COMP.
01 errcnt PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 code1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 code2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 t1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 t2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 f1 PIC S9V9(15).
01 f2 PIC S9V9(15).
01 uid PIC X(18).
01 uidx PIC X(18).
01 FLOAT-DSP PIC -9.9(15).
01 SQL-COD PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
* date_time declaration *
01 TO-DAY PIC 9(6).
01 THE-TIME PIC 9(8).
PROCEDURE DIVISION.
P0.
MOVE "HU" TO uid
CALL "AUTHID" USING uid
MOVE "not logged in, not" TO uidx
CALL "AUTHCK" USING SQLCODE uidx
MOVE SQLCODE TO SQL-COD
if (uid NOT = uidx) then
DISPLAY "ERROR: User " uid " expected."
DISPLAY "User " uidx " connected."
DISPLAY " "
STOP RUN
END-IF
MOVE 0 TO errcnt
DISPLAY
"SQL Test Suite, V6.0, Module COBOL, dml055.sco"
DISPLAY " "
DISPLAY
"59-byte ID"
DISPLAY "TEd Version #"
DISPLAY " "
* date_time print *
ACCEPT TO-DAY FROM DATE
ACCEPT THE-TIME FROM TIME
DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIME
******************** BEGIN TEST0243 *******************
DISPLAY " FIPS sizing TEST0243"
DISPLAY "reference: X3.135-1989 5.5 FIPS PUB 127-1 Section
- " 13.5"
DISPLAY " The precision of SMALLINT is at least 4 digits"
DISPLAY " - - - - - - - - - - - - - - - - - - -"
DISPLAY " *** CREATE TABLE HH (SMALLTEST SMALLINT) "
DISPLAY " INSERT INTO HH "
DISPLAY " VALUES(9999);"
DISPLAY " "
DISPLAY " SELECT COUNT(*) INTO :count1 FROM HH"
DISPLAY " WHERE SMALLTEST = 9999; "
DISPLAY " "
DISPLAY " INSERT INTO HH "
DISPLAY " VALUES(-9999);"
DISPLAY " "
DISPLAY " SELECT SMALLTEST INTO :count2 FROM HH"
DISPLAY " WHERE SMALLTEST = -9999; "
DISPLAY " "
* EXEC SQL DELETE FROM HH;
CALL "SUB1" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO HH
* VALUES(9999) END-EXEC
CALL "SUB2" USING SQLCODE
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO code1
MOVE 0 TO count1
* EXEC SQL SELECT COUNT(*) INTO :count1 FROM HH
* WHERE SMALLTEST = 9999 END-EXEC
CALL "SUB3" USING SQLCODE count1
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO HH
* VALUES(-9999) END-EXEC
CALL "SUB4" USING SQLCODE
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO code2
MOVE 0 TO count2
* EXEC SQL SELECT SMALLTEST INTO :count2 FROM HH
* WHERE SMALLTEST = -9999 END-EXEC
CALL "SUB5" USING SQLCODE count2
MOVE SQLCODE TO SQL-COD
DISPLAY "The correct answer should be:"
DISPLAY " code1 = 0, code2 = 0 "
DISPLAY " count1 = 1,count2 = -9999"
DISPLAY "Your answer is:"
DISPLAY " code1 = ", code1 ",code2 = ", code2
DISPLAY " count1 = ", count1 ",count2 = ",
count2
* EXEC SQL ROLLBACK WORK;
CALL "SUB6" USING SQLCODE
MOVE SQLCODE TO SQL-COD
if (code1 = 0 AND code2 = 0 AND count1 = 1 AND
count2 = -9999) then
* EXEC SQL INSERT INTO TESTREPORT
* VALUES('0243','pass','MCO') END-EXEC
CALL "SUB7" USING SQLCODE
MOVE SQLCODE TO SQL-COD
DISPLAY " *** pass *** "
else
* EXEC SQL INSERT INTO TESTREPORT
* VALUES('0243','fail','MCO') END-EXEC
ADD 1 TO errcnt
CALL "SUB8" USING SQLCODE
MOVE SQLCODE TO SQL-COD
DISPLAY " dml055.sco *** fail *** "
END-IF
DISPLAY "================================================"
DISPLAY " "
* EXEC SQL COMMIT WORK;
CALL "SUB9" USING SQLCODE
MOVE SQLCODE TO SQL-COD
******************** END TEST0243 *******************
******************** BEGIN TEST0244 *******************
DISPLAY " FIPS sizing TEST0244"
DISPLAY "reference: X3.135-1989 5.5 FIPS PUB 127-1 Section
- " 13.5"
DISPLAY " The precision of INTEGER is at least 9 digits"
DISPLAY " - - - - - - - - - - - - - - - - - - -"
DISPLAY " *** CREATE TABLE EE (INTTEST INTEGER) "
DISPLAY " INSERT INTO EE "
DISPLAY " VALUES(999999999);"
DISPLAY " "
DISPLAY " SELECT INTTEST INTO :count1"
DISPLAY " FROM EE"
DISPLAY " WHERE INTTEST = 999999999;"
DISPLAY " "
DISPLAY " INSERT INTO EE "
DISPLAY " VALUES(-999999999);"
DISPLAY " "
DISPLAY " SELECT COUNT(*) INTO :count2"
DISPLAY " FROM EE"
DISPLAY " WHERE INTTEST = -999999999;"
DISPLAY " "
MOVE 0 TO count1
MOVE 0 TO count2
* EXEC SQL DELETE FROM EE;
CALL "SUB10" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO EE
* VALUES(999999999) END-EXEC
CALL "SUB11" USING SQLCODE
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO code1
* EXEC SQL SELECT INTTEST INTO :count1
* FROM EE
* WHERE INTTEST = 999999999 END-EXEC
CALL "SUB12" USING SQLCODE count1
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO EE
* VALUES(-999999999) END-EXEC
CALL "SUB13" USING SQLCODE
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO code2
* EXEC SQL SELECT COUNT(*) INTO :count2
* FROM EE
* WHERE INTTEST = -999999999 END-EXEC
CALL "SUB14" USING SQLCODE count2
MOVE SQLCODE TO SQL-COD
DISPLAY "The correct answer should be:"
DISPLAY " code1 = 0, code2 = 0 "
DISPLAY " count1 = 999999999,count2 = 1"
DISPLAY "Your answer is:"
DISPLAY " code1 = ", code1 ",code2 = ", code2
DISPLAY " count1 = ", count1 ",count2 = ",
count2
* EXEC SQL ROLLBACK WORK;
CALL "SUB15" USING SQLCODE
MOVE SQLCODE TO SQL-COD
if (code1 = 0 AND code2 = 0 AND count1 = 999999999
AND count2 = 1) then
* EXEC SQL INSERT INTO TESTREPORT
* VALUES('0244','pass','MCO') END-EXEC
CALL "SUB16" USING SQLCODE
MOVE SQLCODE TO SQL-COD
DISPLAY " *** pass *** "
else
* EXEC SQL INSERT INTO TESTREPORT
* VALUES('0244','fail','MCO') END-EXEC
ADD 1 TO errcnt
CALL "SUB17" USING SQLCODE
MOVE SQLCODE TO SQL-COD
DISPLAY " dml055.sco *** fail *** "
END-IF
DISPLAY "================================================"
DISPLAY " "
* EXEC SQL COMMIT WORK;
CALL "SUB18" USING SQLCODE
MOVE SQLCODE TO SQL-COD
******************** END TEST0244 *******************
******************** BEGIN TEST0245 *******************
DISPLAY " FIPS sizing TEST0245"
DISPLAY "reference: X3.135-1989 5.5 FIPS PUB 127-1 Section
- " 13.5"
DISPLAY " The precision of DECIMAL is at least 15 digits"
DISPLAY " - - - - - - - - - - - - - - - - - - -"
DISPLAY " *** CREATE TABLE PP_15 (NUMTEST
- " DECIMAL(15,15)) "
DISPLAY " INSERT INTO PP_15 "
DISPLAY " VALUES(.123456789012345);"
DISPLAY " "
DISPLAY " DECLARE DATA9 CURSOR"
DISPLAY " FOR SELECT NUMTEST"
DISPLAY " FROM PP_15;"
DISPLAY " FETCH DATA9 INTO :float1;"
DISPLAY " INSERT INTO PP_15 "
DISPLAY " VALUES(-.912345678901234);"
DISPLAY " FETCH DATA9 INTO :float2;"
DISPLAY " "
DISPLAY "EXEC SQL SELECT COUNT(*) INTO :count1 FROM PP_15"
DISPLAY " WHERE NUMTEST = -0.912345678901234;"
DISPLAY " "
* EXEC SQL DELETE FROM PP_15;
CALL "SUB19" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO PP_15
* VALUES(.123456789012345) END-EXEC
CALL "SUB20" USING SQLCODE
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO code1
* EXEC SQL DECLARE DATA9 CURSOR
* FOR SELECT NUMTEST
* FROM PP_15 END-EXEC
* EXEC SQL OPEN DATA9;
CALL "SUB21" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL FETCH DATA9 INTO :float1;
CALL "SUB22" USING SQLCODE float1
MOVE SQLCODE TO SQL-COD
* EXEC SQL CLOSE DATA9;
CALL "SUB23" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL DELETE FROM PP_15;
CALL "SUB24" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL INSERT INTO PP_15
* VALUES(-.912345678901234) END-EXEC
CALL "SUB25" USING SQLCODE
MOVE SQLCODE TO SQL-COD
MOVE SQLCODE TO code2
* EXEC SQL OPEN DATA9;
CALL "SUB21" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL FETCH DATA9 INTO :float2;
CALL "SUB27" USING SQLCODE float2
MOVE SQLCODE TO SQL-COD
* EXEC SQL CLOSE DATA9;
CALL "SUB28" USING SQLCODE
MOVE SQLCODE TO SQL-COD
MOVE 0 TO count1
* EXEC SQL SELECT COUNT(*) INTO :count1 FROM PP_15
* WHERE NUMTEST = -0.912345678901234 END-EXEC
CALL "SUB29" USING SQLCODE count1
MOVE SQLCODE TO SQL-COD
DISPLAY "The correct answer should be:"
DISPLAY " code1 = 0, code2 = 0 "
DISPLAY " float1 = 0.123456789012345"
DISPLAY " float2 = -0.912345678901234"
DISPLAY " count1 = 1 "
DISPLAY "Your answer is:"
DISPLAY " code1 = ", code1 ",code2 = ", code2
MOVE float1 TO FLOAT-DSP
DISPLAY " float1 = ", FLOAT-DSP
MOVE float2 TO FLOAT-DSP
DISPLAY " float2 = ", FLOAT-DSP
DISPLAY " count1 = ", count1
if (float1 > 0.123456789012345) then
COMPUTE f1 = float1 - 0.123456789012345
else
COMPUTE f1 = 0.123456789012345 - float1
END-IF
if (float2 > -0.912345678901234) then
COMPUTE f2 = float2 + 0.912345678901234
else
COMPUTE f2 = -0.912345678901234 - float2
END-IF
if (f1 < 0.000000000000005) then
MOVE 0 TO t1
else
MOVE 1 TO t1
END-IF
if (f2 < 0.000000000000005) then
MOVE 0 TO t2
else
MOVE 1 TO t2
END-IF
* EXEC SQL ROLLBACK WORK;
CALL "SUB30" USING SQLCODE
MOVE SQLCODE TO SQL-COD
if (code1 = 0 AND code2 = 0 AND t1 = 0 AND t2 =
0 AND count1 = 1) then
* EXEC SQL INSERT INTO TESTREPORT
* VALUES('0245','pass','MCO') END-EXEC
CALL "SUB31" USING SQLCODE
MOVE SQLCODE TO SQL-COD
DISPLAY " *** pass *** "
else
* EXEC SQL INSERT INTO TESTREPORT
* VALUES('0245','fail','MCO') END-EXEC
ADD 1 TO errcnt
CALL "SUB32" USING SQLCODE
MOVE SQLCODE TO SQL-COD
DISPLAY " dml055.sco *** fail *** "
END-IF
DISPLAY "================================================"
DISPLAY " "
* EXEC SQL COMMIT WORK;
CALL "SUB33" USING SQLCODE
MOVE SQLCODE TO SQL-COD
******************** END TEST0245 *******************
**** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0
STOP RUN.
* **** Procedures for PERFORM statements
¤ Dauer der Verarbeitung: 0.24 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.
|
