IDENTIFICATION DIVISION.
PROGRAM-ID. COB001.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. xyz.
OBJECT-COMPUTER. xyz.
DATA DIVISION.
WORKING-STORAGE SECTION.
* EMBEDDED COBOL (file "COB001.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.
*
* COB001.PCO
* WRITTEN BY: S Hurwitz
*
* This routine tests a variety of COBOL host identifiers that
* are allowed in the embedded language of SQL.
*
* 01 <COBOL host identifier> <type specification>
* 77 <COBOL host identifier> <type specification>
*
* REFERENCES
* AMERICAN NATIONAL STANDARD database language - SQL
* X3.135-1989
*
* Section ANNEX C. <embedded SQL COBOL program>
**************************************************************
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 PNUMabcdefghijkABCDEFGHIJK-001 pic x(3).
01 PNUMabcdefghijkABCDEFGHIJK-002 pic x(3).
01 EMPNAME-123456-123456-abc pic x(20).
01 123456-EMPNUM pic x(3).
01 CITY1---city1 pic x(15).
01 000CITY pic x(15).
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 errflg pic 99.
01 pnum001 pic x(3).
* date_time declaration *
01 TO-DAY PIC 9(6).
01 THE-TIME PIC 9(8).
PROCEDURE DIVISION.
P0.
*initalize
move 0 to errflg.
move spaces to pnum001.
*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, cob001.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
******************** BEGIN TEST0185 ********************
display " TEST0185 ".
display " Testing COBOL host identifiers ".
display " reference X3. 135-1986 section ANNEX C ".
display "- - - - - - - - - - - - - - - - - - - - - - -".
display " ".
EXEC SQL SELECT EMPNUM,EMPNAME
INTO :123456-EMPNUM,
:EMPNAME-123456-123456-abc
FROM STAFF
WHERE CITY='Akron'
END-EXEC.
display " 123456-EMPNUM=" 123456-EMPNUM
" EMPNAME-123456-123456-abc= " EMPNAME-123456-123456-abc.
display "The answer should be 123456-EMPNUM=E5 and "
" EMPNAME-123456-123456-abc= Ed".
if 123456-EMPNUM not = "E5" add 1 to errflg.
if EMPNAME-123456-123456-abc not = "Ed" add 1 to errflg.
display "- - - - - - - - - - - - - - - - - - - - - -".
EXEC SQL SELECT PNUM,CITY
INTO :PNUMabcdefghijkABCDEFGHIJK-001,
:CITY1---city1
FROM PROJ
WHERE PNAME = 'CALM'
END-EXEC.
display " PNUMabcdefghijkABCKEFGHIJK-001="
PNUMabcdefghijkABCDEFGHIJK-001
" CITY1---city1= " CITY1---city1.
display "The answer should be "
"PNUMabcdefghijkABCDEFGHIJK-001=P2 and "
"CITY1---city1= Vienna".
if PNUMabcdefghijkABCDEFGHIJK-001 not = "P2"
add 1 to errflg.
if CITY1---city1 not = "Vienna" add 1 to errflg.
move PNUMabcdefghijkABCDEFGHIJK-001 to pnum001.
display "- - - - - - - - - - - - - - - - - - - - - -".
EXEC SQL SELECT PNUM,CITY
INTO :PNUMabcdefghijkABCDEFGHIJK-002,
:000CITY
FROM PROJ
WHERE PNAME = 'PAYR'
END-EXEC.
display " PNUMabcdefghijkABCDEFGHIJK-002="
PNUMabcdefghijkABCDEFGHIJK-002
" 000CITY = " 000CITY.
display "The answer should be"
" PNUMabcdefghijkABCDEFGHIJK-002= P6 and "
" 000CITY= Deale".
if PNUMabcdefghijkABCDEFGHIJK-002 not = "P6" add 1 to errflg.
if 000CITY not = "Deale" add 1 to errflg.
if pnum001 = PNUMabcdefghijkABCDEFGHIJK-002
add 1 to errflg.
if pnum001 not = PNUMabcdefghijkABCDEFGHIJK-001
add 1 to errflg.
display "- - - - - - - - - - - - - - - - - - - - - - -".
display " ERRFLG= " errflg
" **** maximum number of errors is 8 ***".
if errflg = 0
display " *** pass ***"
display "============================================="
EXEC SQL INSERT INTO TESTREPORT
VALUES('0185','pass','PCO') END-EXEC
else
display " cob001.pco *** fail ***"
display "================================================"
EXEC SQL INSERT INTO TESTREPORT
VALUES('0185','fail','PCO') END-EXEC
ADD 1 TO errcnt
END-IF
display " ".
EXEC SQL COMMIT WORK END-EXEC.
******************** END TEST0185 *********************
**** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0
STOP RUN.
*********************************************************
¤ Dauer der Verarbeitung: 0.18 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.
|