|
IDENTIFICATION DIVISION.
PROGRAM-ID. COB008.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. xyz.
OBJECT-COMPUTER. xyz.
DATA DIVISION.
WORKING-STORAGE SECTION.
* Standard COBOL (file "COB008.SCO") calling SQL
* procedures in file "COB008.MCO"
***************************************************************
*
* COMMENT SECTION
*
* DATE 1989/01/16 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.
*
* COB008.SCO
* WRITTEN BY: S Hurwitz
* TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE
*
* THIS ROUTINE TESTS COBOL DATA TYPES IN SQL LANGUAGE.
*
* REFERENCES
* AMERICAN NATIONAL STANDARD database language - SQL
* X3.135-1989
*
* SECTION 5.5 <data type>
* ANNEX C. <embedded SQL COBOL program>
*
*
***************************************************************
* EXEC SQL BEGIN DECLARE SECTION END-EXEC
01 var1 PIC S9(5)V99 DISPLAY SIGN LEADING SEPARATE.
01 var2 PIC S99V DISPLAY SIGN LEADING SEPARATE.
01 var3 PIC S99999V DISPLAY SIGN LEADING SEPARATE.
01 var4 PIC S9(6)V9(3) DISPLAY SIGN LEADING SEPARATE.
01 var5 PIC S9(5)V9(3) DISPLAY SIGN LEADING SEPARATE.
01 var6 PIC SV99 DISPLAY SIGN LEADING SEPARATE.
* EXEC SQL END DECLARE SECTION END-EXEC
01 ed-var1 PIC 99999.99.
01 ed-var2 PIC 99.
01 ed-var3 PIC 99999.
01 ed-var4 PIC 999999.999.
01 ed-var5 PIC 99999.999.
01 ed-var6 PIC .99.
01 uid PIC X(18).
01 uidx PIC X(18).
01 cnt PIC 9.
01 SQL-COD PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 SQLCODE PIC S9(9) COMP.
01 errcnt PIC S9(4) 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, cob008.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 TEST0235 *******************
DISPLAY " TEST0235"
DISPLAY "reference: X3.135-1989 5.5 & ANNEX C. "
DISPLAY
"- - - - - - - - - - - - - - - - - - - - - - - - - - -"
DISPLAY " "
DISPLAY "*** CREATE TABLE SV (numtest NUMERIC (8,3)) "
DISPLAY "*** INSERT INTO SV "
DISPLAY "*** VALUES(12345.678) "
MOVE 0 TO cnt
* EXEC SQL DELETE FROM SV;
CALL "SUB1" USING SQLCODE
* EXEC SQL INSERT INTO SV
* VALUES(12345.678) END-EXEC
CALL "SUB2" USING SQLCODE
MOVE SQLCODE TO SQL-COD
DISPLAY "After INSERT SQLCODE = ", SQL-COD
DISPLAY " "
MOVE 0 TO var1
* EXEC SQL SELECT *
* INTO :var1
* FROM SV END-EXEC
CALL "SUB3" USING SQLCODE var1
MOVE SQLCODE TO SQL-COD
DISPLAY "After SELECT into var1 the SQLCODE = ", SQL-COD
DISPLAY "*** to check exact numeric type S9(5)V99 ***"
DISPLAY
"*** var1 answer should be either 12345.67 or 12345.68 ***"
MOVE var1 TO ed-var1
DISPLAY " var1 = ", ed-var1
if (var1 = 12345.67 or var1 = 12345.68) ADD 1 TO cnt END-IF
DISPLAY " "
MOVE 0 TO var3
* EXEC SQL SELECT *
* INTO :var3
* FROM SV END-EXEC
CALL "SUB4" USING SQLCODE var3
MOVE SQLCODE TO SQL-COD
DISPLAY "After SELECT into var3 the SQLCODE = ", SQL-COD
DISPLAY "*** to check exact numeric type S99999V ***"
DISPLAY
"*** var3 answer should be either 12345 or 12346 ***"
MOVE var3 TO ed-var3
DISPLAY " var3 = ", ed-var3
if ((var3 = 12345) or (var3 = 12346)) ADD 1 TO cnt END-IF
DISPLAY " "
MOVE 0 TO var4
* EXEC SQL SELECT *
* INTO :var4
* FROM SV END-EXEC
CALL "SUB5" USING SQLCODE var4
MOVE SQLCODE TO SQL-COD
DISPLAY "After SELECT into var4 the SQLCODE = ", SQL-COD
DISPLAY "*** to check exact numeric type S9(6)V9(3) ***"
DISPLAY "*** var4 answer should be 12345.678 ***"
MOVE var4 TO ed-var4
DISPLAY " var4 = ", ed-var4
if (var4 = 12345.678) ADD 1 TO cnt END-IF
DISPLAY " "
MOVE 0 TO var5
* EXEC SQL SELECT *
* INTO :var5
* FROM SV END-EXEC
CALL "SUB6" USING SQLCODE var5
MOVE SQLCODE TO SQL-COD
DISPLAY "After SELECT into var5 the SQLCODE = ", SQL-COD
DISPLAY "*** to check exact numeric type S9(5)V9(3) ***"
DISPLAY "*** var5 answer should be 12345.678 ***"
MOVE var5 TO ed-var5
DISPLAY " var5 = ", ed-var5
if (var5 = 12345.678) ADD 1 TO cnt END-IF
* EXEC SQL ROLLBACK WORK;
CALL "SUB7" USING SQLCODE
if ( cnt = 4 ) then
DISPLAY " "
DISPLAY " *** pass ***"
* EXEC SQL INSERT INTO TESTREPORT
* VALUES('0235','pass','MCO') END-EXEC
CALL "SUB8" USING SQLCODE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " cob008.sco *** fail ***"
* EXEC SQL INSERT INTO TESTREPORT
* VALUES('0235','fail','MCO') END-EXEC
ADD 1 TO errcnt
CALL "SUB9" USING SQLCODE
MOVE SQLCODE TO SQL-COD
END-IF
DISPLAY
"====================================================="
DISPLAY " "
* EXEC SQL COMMIT WORK;
CALL "SUB15" USING SQLCODE
******************** END TEST0235 *******************
******************** BEGIN TEST0236 *******************
DISPLAY " TEST0236"
DISPLAY "reference: X3.135-1989 5.5 & ANNEX C. "
DISPLAY "reference: X3.135-1989 8.10 GR 9) d) exact numeric"
DISPLAY "reference: X3.135-1989 3.3 Conventions "
DISPLAY "reference: X3.135-1989 4.10.1 SQLCODE parameter "
DISPLAY " "
DISPLAY
"- - - - - - - - - - - - - - - - - - - - - - - - - - -"
* EXEC SQL DELETE FROM SV;
CALL "SUB1" USING SQLCODE
* EXEC SQL INSERT INTO SV
* VALUES(12345.678) END-EXEC
CALL "SUB2" USING SQLCODE
MOVE SQLCODE TO SQL-COD
DISPLAY "After INSERT SQLCODE = ", SQL-COD
MOVE 0 TO cnt
DISPLAY " "
MOVE 0 TO var2
* EXEC SQL SELECT *
* INTO :var2
* FROM SV END-EXEC
CALL "SUB10" USING SQLCODE var2
MOVE SQLCODE TO SQL-COD
DISPLAY "After SELECT into var2, the SQLCODE = ", SQL-COD
DISPLAY
"*** checks SELECT into exact numeric type S99V ***"
DISPLAY
"*** from type S9(5)V9(3) ***"
DISPLAY
"The answer should be a NEGATIVE SQLCODE- - -EXCEPTION!! "
MOVE var2 TO ed-var2
DISPLAY " var2 = ", ed-var2
if (SQLCODE < 0 ) ADD 1 TO cnt END-IF
DISPLAY " "
MOVE 0 TO var6
* EXEC SQL SELECT *
* INTO :var6
* FROM SV END-EXEC
CALL "SUB11" USING SQLCODE var6
MOVE SQLCODE TO SQL-COD
DISPLAY "After SELECT into var6, the SQLCODE = ", SQL-COD
DISPLAY
"*** checks SELECT into exact numeric type SV99 ***"
DISPLAY
"*** from type S9(5)V9(3) ***"
DISPLAY
"The answer should be a NEGATIVE SQLCODE- - -EXCEPTION!! "
MOVE var6 TO ed-var6
DISPLAY " var6 = ", ed-var6
if (SQLCODE < 0 ) ADD 1 TO cnt END-IF
* EXEC SQL ROLLBACK WORK;
CALL "SUB12" USING SQLCODE
if ( cnt = 2 ) then
DISPLAY " "
DISPLAY " *** pass ***"
* EXEC SQL INSERT INTO TESTREPORT
* VALUES('0236','pass','MCO') END-EXEC
CALL "SUB13" USING SQLCODE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " cob008.sco *** fail ***"
* EXEC SQL INSERT INTO TESTREPORT
* VALUES('0236','fail','MCO') END-EXEC
ADD 1 TO errcnt
CALL "SUB14" USING SQLCODE
MOVE SQLCODE TO SQL-COD
END-IF
DISPLAY
"====================================================="
DISPLAY " "
* EXEC SQL COMMIT WORK;
CALL "SUB15" USING SQLCODE
******************** END TEST0236 *******************
**** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0
STOP RUN.
¤ Dauer der Verarbeitung: 0.19 Sekunden
(vorverarbeitet)
¤
|
schauen Sie vor die Tür
Fenster
Die Firma ist wie angegeben erreichbar.
Die farbliche Syntaxdarstellung ist noch experimentell.
|
