| products/Sources/formale Sprachen/Cobol/Test-Suite/SQL P/xts/ |
|
Quellcode-Bibliothek© Kompilation durch diese Firma[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]Datei: cdr007.cob Sprache: Cobol |
|
||||||
|
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.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.Bot Zugriff |
