|
IDENTIFICATION DIVISION.
PROGRAM-ID. COB002.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. xyz.
OBJECT-COMPUTER. xyz.
DATA DIVISION.
WORKING-STORAGE SECTION.
* EMBEDDED COBOL (file "COB002.PCO")
**************************************************************
*
* COMMENT SECTION
*
* DATE 1988/06/26 EMBEDDED 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.
*
* COB002.PCO
* WRITTEN BY: S Hurwitz
*
* This routine tests how the SQL language handles
* the length of several COBOL alphanumeric character strings.
*
* Examples:
* 01 xyz1 PIC X(80).
* 01 xyz2 PIC X(132).
* 01 xyz3 PIC X(240).
*
* REFERENCES
* AMERICAN NATIONAL STANDARD database language - SQL
* X3.135-1989
* SECTION 5.5 <data type> Syntax Rule 5).
* SECTION ANNEX C. <embedded SQL COBOL program>
* Snytax Rule 4)c).
***************************************************************
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 IN80 PIC X(80).
01 IN132 PIC X(132).
01 IN240 PIC X(240).
01 OUT80 PIC X(80).
01 OUT132 PIC X(132).
01 OUT240 PIC X(240).
01 uid PIC X(18).
01 uidx PIC X(18).
EXEC SQL END DECLARE SECTION END-EXEC.
01 SQLCODE PIC S9(9) COMP.
01 errcnt PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
01 XYZ1 PIC X(80) value is "NOTE: Additional SQL
- " language is planned for later addenda to this
- " standard. M".
01 XYZ2 PIC X(52) value is "ajor topics under consid
- "eration for such addenda inc".
01 XYZ3 PIC X(108) value is "lude referential integrity,
- " enhanced transaction management, specification
- " of certain implementor-defined ru".
01 XYZ4 PIC X(16) value is "les, enhanced ch".
01 T80.
05 aa80 PIC X(80).
01 T132.
05 aa132 PIC X(80).
05 bb132 PIC X(52).
01 T240.
05 aa240 PIC X(80).
05 bb240 PIC X(52).
05 cc240 PIC X(108).
* date_time declaration *
01 TO-DAY PIC 9(6).
01 THE-TIME PIC 9(8).
PROCEDURE DIVISION.
P0.
*log into database
move "HU" to uid.
CALL "AUTHID" USING uid.
MOVE "not logged in, not" TO uidx
EXEC SQL SELECT
USER INTO :uidx FROM HU.ECCO END-EXEC
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, Embedded COBOL, cob002.pco"
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
display " Testing COBOL character string lengths ".
display " reference X3. 135-1986 SECTION 5.5 ".
display " syntax rule 5). ".
display " reference SECTION ANNEX C. syntax rule 4)c). ".
display " - - - - - - - - - - - - - - - - - - - - - ".
move XYZ1 to aa80 aa132 aa240.
move XYZ2 to bb132 bb240.
move XYZ3 to cc240.
move T80 to IN80.
move T132 to IN132.
move T240 to IN240.
******************** BEGIN TEST0186 ********************
display " ".
display " TEST0186 ".
display " *** Testing character string length 80 ***".
display " ".
EXEC SQL DELETE FROM TEXT80
END-EXEC.
EXEC SQL INSERT
INTO TEXT80(TEXXT)
VALUES (:IN80)
END-EXEC.
EXEC SQL SELECT
TEXXT INTO :OUT80 FROM TEXT80
END-EXEC.
display " OUT80= " OUT80.
if OUT80 = T80
display " "
display " *** pass *** "
display " "
display "=========================================="
EXEC SQL INSERT INTO TESTREPORT
VALUES('0186','pass','PCO') END-EXEC
else
display " "
display " cob002.pco *** fail *** "
display " "
display "============================================"
EXEC SQL INSERT INTO TESTREPORT
VALUES('0186','fail','PCO') END-EXEC
ADD 1 TO errcnt
END-IF
EXEC SQL COMMIT WORK END-EXEC.
******************** END TEST0186 *********************
******************** BEGIN TEST0187 ********************
display " ".
display " TEST0187 ".
display " **** Testing character string length 132 *** ".
display " ".
EXEC SQL DELETE
FROM TEXT132
END-EXEC.
EXEC SQL INSERT
INTO TEXT132(TEXXT)
VALUES (:IN132)
END-EXEC.
EXEC SQL SELECT
TEXXT INTO :OUT132 FROM TEXT132
END-EXEC.
display " OUT132= " OUT132.
if OUT132 = T132
display " "
display " *** pass *** "
display " "
display "=============================================="
EXEC SQL INSERT INTO TESTREPORT
VALUES ('0187','pass','PCO') END-EXEC
else
display " "
display " cob002.pco *** fail *** "
display " "
display "==============================================="
EXEC SQL INSERT INTO TESTREPORT
VALUES ('0187','fail','PCO') END-EXEC
ADD 1 TO errcnt
END-IF
EXEC SQL COMMIT WORK END-EXEC.
******************** END TEST0187 *********************
******************** BEGIN TEST0188 ********************
display " ".
display " TEST0188 ".
display " *** Testing character string length 240 ***".
display " ".
EXEC SQL DELETE
FROM TEXT240
END-EXEC.
EXEC SQL INSERT
INTO TEXT240(TEXXT)
VALUES (:IN240)
END-EXEC.
EXEC SQL SELECT
TEXXT INTO :OUT240 FROM TEXT240
END-EXEC.
display " OUT240= " OUT240.
if OUT240 = T240
display " "
display " *** pass *** "
display " "
display "=============================================="
EXEC SQL INSERT INTO TESTREPORT
VALUES('0188','pass','PCO') END-EXEC
else
display " "
display " cob002.pco *** fail *** "
display " "
display "=============================================="
EXEC SQL INSERT INTO TESTREPORT
VALUES ('0188','fail','PCO') END-EXEC
ADD 1 TO errcnt
END-IF
EXEC SQL COMMIT WORK END-EXEC.
******************** END TEST0188 *********************
*********************************************************
**** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0
STOP RUN.
*********************************************************
¤ Dauer der Verarbeitung: 0.32 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.
|
