|
IDENTIFICATION DIVISION.
PROGRAM-ID. XOP701.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. xyz.
OBJECT-COMPUTER. xyz.
DATA DIVISION.
WORKING-STORAGE SECTION.
* Embedded SQL COBOL (file "XOP701.PCO")
* Copyright 1994, 1995 X/Open Company Limited
* All rights reserved.
* DISCLAIMER:
* This program was reviewed by employees of NIST for
* conformance to the SQL standards.
* NIST assumes no responsibility for any party's use of
* this program.
* X/Open and the 'X' symbol are registered trademarks of X/Open Company
* Limited in the UK and other countries.
****************************************************************
*
* COMMENT SECTION
*
* DATE 1994/05/03 EMBEDDED C LANGUAGE
* X/Open SQL VALIDATION TEST SUITE V6.0
*
* XOP701.PCO
* WRITTEN BY: Colin O'Driscoll
*
* WHENEVER SQLWARNING and Scoping of 'C' Labels as targets
* for WHENEVER
*
* REFERENCES
* X/OPEN CAE SQL Specification
* Section 4.6
*
* <embedded SQL C program>
*
* DATE PROGRAM LAST CHANGED 1/11/94
*
****************************************************************
EXEC SQL BEGIN DECLARE SECTION END-EXEC
01 SQLSTATE PIC X(5).
01 testchar PIC X(3).
01 testint PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 uid PIC X(18).
01 uidx PIC X(18).
EXEC SQL END DECLARE SECTION END-EXEC
EXEC SQL INCLUDE SQLCA END-EXEC.
01 errcnt PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
*date_time declaration
01 TO-DAY PIC 9(6).
01 THE-TIME PIC 9(8).
01 errflg PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 SQL-COD PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
PROCEDURE DIVISION.
P0.
MOVE "XOPEN1" TO uid
CALL "AUTHID" USING uid
MOVE "not logged in, not" TO uidx
EXEC SQL SELECT USER INTO :uidx FROM XOPEN1.ECCO END-EXEC
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 "X/OPEN Extensions SQL Test Suite, V6.0, Embedded
- "COBOL, xop701.pco"
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 TEST0701 *******************
DISPLAY " TEST0701 "
DISPLAY " X/O,WHENEVER SQLWARNING and scoping of 'C' labels"
DISPLAY " X/Open CAE SQL Sec 4.6"
DISPLAY " - - - - - - - - - - - - - - - - - - -"
DISPLAY "### WHENEVER SQLWARNING GOTO P100;"
DISPLAY "### SELECT SUM(TESTINT) INTO :testint "
DISPLAY "### FROM WARNING;"
DISPLAY "### WHENEVER SQLWARNING GO TO P101;"
DISPLAY "### SELECT TESTCHAR INTO :testchar FROM
- " WARNING"
DISPLAY "### WHERE TESTINT = 1;"
DISPLAY "### WHENEVER SQLWARNING GOTO P102;"
DISPLAY "### WHENEVER SQLWARNING CONTINUE;"
DISPLAY "### SELECT SUM(TESTINT) INTO :testint"
DISPLAY "### FROM WARNING;"
DISPLAY "### WHENEVER SQLWARNING GO TO P104;"
DISPLAY "### SELECT AVG(TESTINT) INTO :testint"
DISPLAY "### FROM WARNING;"
DISPLAY "================================================="
MOVE 0 TO errflg
*Load values into WARNING table
EXEC SQL INSERT INTO WARNING
VALUES ('AAAAAA', 1) END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL INSERT INTO WARNING
VALUES ('BBBBBB', 2) END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL INSERT INTO WARNING
VALUES ('CCCCCC', NULL) END-EXEC
MOVE SQLCODE TO SQL-COD
*Start new block
EXEC SQL WHENEVER SQLWARNING GOTO P100 END-EXEC
MOVE SQLCODE TO SQL-COD
*Generate warning
EXEC SQL SELECT SUM(TESTINT) INTO :testint
FROM WARNING END-EXEC
MOVE SQLCODE TO SQL-COD
DISPLAY "================================================="
DISPLAY "Program should jump around this code"
DISPLAY "*** Problem found (TEST STEP NUMBER 1 ) ! *** "
COMPUTE errflg = errflg + 1
DISPLAY "=================================================".
P100.
EXEC SQL WHENEVER SQLWARNING GO TO P101 END-EXEC
MOVE SQLCODE TO SQL-COD
*Generate warning
EXEC SQL SELECT TESTCHAR INTO :testchar
FROM WARNING
WHERE TESTINT = 1 END-EXEC
MOVE SQLCODE TO SQL-COD
DISPLAY "================================================="
DISPLAY "Program should jump around this code"
DISPLAY "*** Problem found (TEST STEP NUMBER 2) ! *** "
COMPUTE errflg = errflg + 1
DISPLAY "=================================================".
P101.
EXEC SQL WHENEVER SQLWARNING GOTO P102 END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL WHENEVER SQLWARNING CONTINUE END-EXEC
MOVE SQLCODE TO SQL-COD
*Generate warning (which shouldn't cause a jump to P102:)
EXEC SQL SELECT SUM(TESTINT) INTO :testint
FROM WARNING END-EXEC
MOVE SQLCODE TO SQL-COD
GO TO P103.
P102.
DISPLAY "================================================="
DISPLAY "Program should jump around this code"
DISPLAY "*** Problem found (TEST STEP NUMBER 3) ! *** "
COMPUTE errflg = errflg + 1
DISPLAY "=================================================".
P103.
EXEC SQL WHENEVER SQLWARNING GO TO P104 END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL SELECT AVG(TESTINT) INTO :testint
FROM WARNING END-EXEC
MOVE SQLCODE TO SQL-COD
*Shouldn't get here
DISPLAY "================================================="
DISPLAY "Program should jump around this code"
DISPLAY "*** Problem found (TEST STEP NUMBER 4) ! *** "
COMPUTE errflg = errflg + 1
DISPLAY "=================================================".
P104.
EXEC SQL WHENEVER SQLWARNING CONTINUE END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL ROLLBACK WORK END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL DELETE FROM WARNING END-EXEC
MOVE SQLCODE TO SQL-COD
DISPLAY "number of errors detected = ", errflg " "
DISPLAY "### maximum number of errors is 4 ###"
if (errflg = 0) then
EXEC SQL INSERT INTO XOPEN1.TESTREPORT
VALUES('0701','pass','PCO') END-EXEC
MOVE SQLCODE TO SQL-COD
DISPLAY " xop701.pco *** pass *** "
else
EXEC SQL INSERT INTO XOPEN1.TESTREPORT
VALUES('0701','fail','PCO') END-EXEC
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
DISPLAY " xop701.pco *** fail *** "
END-IF
DISPLAY "================================================="
DISPLAY " "
EXEC SQL COMMIT WORK END-EXEC
MOVE SQLCODE TO SQL-COD
******************** END TEST0701 *******************
****** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0
STOP RUN.
* **** Procedures for PERFORM statements
¤ Dauer der Verarbeitung: 0.25 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.
|
