| products/Sources/formale Sprachen/Cobol/Test-Suite/SQL M/ |
|
Quellcode-Bibliothek© Kompilation durch diese Firma[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]Datei: xts725.cob Sprache: Cobol |
|
||||||
|
IDENTIFICATION DIVISION.
PROGRAM-ID. XTS725. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. xyz. OBJECT-COMPUTER. xyz. DATA DIVISION. WORKING-STORAGE SECTION. * Standard COBOL (file "XTS725.SCO") calling SQL * procedures in file "XTS725.MCO". *Copyright 1995 National Computing Centre Limited *and Computer Logic R&D S.A *on behalf of the CTS5 SQL2 Project. *All rights reserved. *The CTS5 SQL2 Project is sponsored by the European Community. * *The National Computing Centre Limited and Computer Logic R&D *have given permission to NIST to distribute this program *over the World Wide Web in order to promote SQL standards. *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. **************************************************************** * * COMMENT SECTION * * SQL VALIDATION TEST SUITE V6.0 * * XTS725.SCO * WRITTEN BY: Nickos Backalidis * TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE * * Flagging, Full SQL INSENSITIVE cursor * * REFERENCES * 13.1 -- <declare cursor> * 13.2 -- <open statement> * 13.3 -- GR.3.e.i * F#79 -- Insensitive cursors * F#37 -- Intermediate SQL Flagging * * DATE LAST ALTERED 14/12/95 CTS5 Hand-over Test * * Cleanups and fixes by V. Kogakis 04/12/95: * Change in the values of rows inserted in the table * * QA Status: QA check * * Revised by DWF 1/30/96 * Removed status checks after cursor definition * Fixed char string lengths **************************************************************** * EXEC SQL BEGIN DECLARE SECTION END-EXEC 01 SQLCODE PIC S9(9) COMP. 01 SQLSTATE PIC X(5). 01 uid PIC X(18). 01 uidx PIC X(18). 01 c_num1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE. 01 c_num2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE. 01 c_ch1 PIC X(10). 01 c_ch2 PIC X(10). * EXEC SQL END DECLARE SECTION END-EXEC 01 norm1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE. 01 norm2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE. 01 ALPNUM-TABLE VALUE IS "01234ABCDEFGH56789IJKLMNOPQRSTUVWXYZ". 05 ALPNUM PIC X OCCURS 36 TIMES. 01 NORMSQ. 05 NORMSQX PIC X OCCURS 5 TIMES. 01 errcnt PIC S9(9) DISPLAY SIGN LEADING SEPARATE. *date_time declaration 01 TO-DAY PIC 9(6). 01 THE-TIME PIC 9(8). 01 flag PIC S9(9) DISPLAY SIGN LEADING SEPARATE. 01 SQL-COD PIC S9(9) DISPLAY SIGN LEADING SEPARATE. PROCEDURE DIVISION. P0. MOVE "CTS1 " TO uid CALL "AUTHID" USING uid MOVE "not logged in, not" TO uidx * EXEC SQL SELECT USER INTO :uidx FROM CTS1.ECCO; CALL "SUB1" USING SQLCODE SQLSTATE uidx MOVE SQLCODE TO SQL-COD * EXEC SQL ROLLBACK WORK; CALL "SUB2" USING SQLCODE SQLSTATE 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 "SQL Test Suite, V6.0, Module COBOL, xts725.sco" 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 TEST7025 ******************* MOVE 1 TO flag DISPLAY " TEST7025" DISPLAY " Flagging - Full SQL INSENSITIVE cursor" DISPLAY "References" DISPLAY " 13.1 -- DISPLAY " 13.2 -- DISPLAY " 13.3 GR.3.e.i " DISPLAY " F#79 -- Insensitive cursors " DISPLAY " F#37 -- Intermediate SQL Flagging " DISPLAY " - - - - - - - - - - - - - - - - - - -" *Initialise error reporting variables COMPUTE SQLCODE = -1 MOVE "xxxxx" TO SQLSTATE *Use standard schema table CTS1.CL_STANDARD *declare an insensitive cursor based on columns of *CTS1.CL_STANDARD DISPLAY "DECLARE CLCURS INSENSITIVE CURSOR" DISPLAY "FOR SELECT COL_NUM1,COL_CH1,COL_NUM2,COL_CH2" DISPLAY "FROM CL_STANDARD" DISPLAY "ORDER BY COL_NUM1 DESC;" * EXEC SQL DECLARE CLCURS INSENSITIVE CURSOR * FOR SELECT COL_NUM1, COL_CH1, COL_NUM2,COL_CH2 * FROM CL_STANDARD * ORDER BY COL_NUM1 DESC END-EXEC DISPLAY "OPEN CLCURS;" * EXEC SQL OPEN CLCURS; CALL "SUB3" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " *NOW insert a row in CL_STANDARD DISPLAY "INSERT INTO CL_STANDARD - " VALUES(1005,'KEVIN',4005,'XIOS');" * EXEC SQL INSERT INTO CL_STANDARD * VALUES(1005,'KEVIN',4005,'XIOS'); CALL "SUB4" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " *initialise host variables MOVE "xxxxxxxxxx" TO c_ch1 MOVE "xxxxxxxxxx" TO c_ch2 MOVE 0 TO c_num1 MOVE 0 TO c_num2 *use a select <statement: single row> and determine *that the row was inserted and is visible DISPLAY "SELECT COL_NUM1,COL_CH1,COL_NUM2,COL_CH2 " DISPLAY "INTO :c_num1, :c_ch1, :c_num2, :c_ch2 " DISPLAY "FROM CL_STANDARD WHERE COL_NUM1 = 1005;" * EXEC SQL SELECT COL_NUM1,COL_CH1,COL_NUM2,COL_CH2 * INTO :c_num1, :c_ch1, :c_num2, :c_ch2 * FROM CL_STANDARD WHERE COL_NUM1 = 1005; CALL "SUB5" USING SQLCODE SQLSTATE c_num1 c_ch1 c_num2 c_ch2 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY "COL_NUM1 should be 1005; it is : ", c_num1 DISPLAY "COL_CH1 should be KEVIN; it is : ", c_ch1 DISPLAY "COL_NUM2 should be 4005; it is : ", c_num2 DISPLAY "COL_CH2 should be XIOS; it is : ", c_ch2 if (c_num1 NOT = 1005 OR c_ch1 NOT = "KEVIN" OR c_num2 NOT = 4005) then MOVE 0 TO flag END-IF if (c_ch2 NOT = "XIOS") then MOVE 0 TO flag END-IF DISPLAY " " *re-initialise host variables MOVE "xxxxxxxxxx" TO c_ch1 MOVE "xxxxxxxxxx" TO c_ch2 MOVE 0 TO c_num1 MOVE 0 TO c_num2 *now start fetching rows from CL_STANDARD DISPLAY "FETCH CLCURS INTO :c_num1, :c_ch1, :c_num2, - " :c_ch2;" * EXEC SQL FETCH CLCURS INTO :c_num1, :c_ch1, :c_num2, :c_ch2 * ; CALL "SUB6" USING SQLCODE SQLSTATE c_num1 c_ch1 c_num2 c_ch2 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK *since the cursor is declared insensitive with cursor *specification ORDER BY DESC the last row will be *returned first however if the inserted row is visible *through the cursor then record a NOGO DISPLAY "COL_NUM1 should be 1004; it is ", c_num1, " " DISPLAY "COL_CH1 should be MORRIS;it is ", c_ch1, " " DISPLAY "COL_NUM2 should be 4004; it is ", c_num2, " " DISPLAY "COL_CH2 should be PARGA; it is ", c_ch2, " " *check if the inserted row is visible through *the cursor proceed if not record a NOGO if it is if (c_num1 NOT = 1004 OR c_ch1 NOT = "MORRIS" OR c_num2 NOT = 4004) then MOVE 0 TO flag END-IF if (c_ch2 NOT = "PARGA") then MOVE 0 TO flag END-IF DISPLAY " " *re-initialise host variables MOVE "xxxxxxxxxx" TO c_ch1 MOVE "xxxxxxxxxx" TO c_ch2 MOVE 0 TO c_num1 MOVE 0 TO c_num2 *fetch second row DISPLAY "FETCH CLCURS INTO :c_num1, :c_ch1, :c_num2, - " :c_ch2;" * EXEC SQL FETCH CLCURS INTO :c_num1, :c_ch1, :c_num2, :c_ch2 * ; CALL "SUB7" USING SQLCODE SQLSTATE c_num1 c_ch1 c_num2 c_ch2 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY "COL_NUM1 should be 1003; it is ", c_num1, " " DISPLAY "COL_CH1 should be GEORGE; it is ", c_ch1, " " DISPLAY "COL_NUM2 should be 4003; it is ", c_num2, " " DISPLAY "COL_CH2 should be ARTA; it is ", c_ch2, " " if (c_num1 NOT = 1003 OR c_ch1 NOT = "GEORGE" OR c_num2 NOT = 4003) then MOVE 0 TO flag END-IF if (c_ch2 NOT = "ARTA") then MOVE 0 TO flag END-IF DISPLAY " " *re-initialise host variables MOVE "xxxxxxxxxx" TO c_ch1 MOVE "xxxxxxxxxx" TO c_ch2 MOVE 0 TO c_num1 MOVE 0 TO c_num2 *fetch third row DISPLAY "FETCH CLCURS INTO :c_num1, :c_ch1, :c_num2, - " :c_ch2;" * EXEC SQL FETCH CLCURS INTO :c_num1, :c_ch1, :c_num2, :c_ch2 * ; CALL "SUB8" USING SQLCODE SQLSTATE c_num1 c_ch1 c_num2 c_ch2 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY "COL_NUM1 should be 1002; it is ", c_num1, " " DISPLAY "COL_CH1 should be MAKIS; it is ", c_ch1, " " DISPLAY "COL_NUM2 should be 4002; it is ", c_num2, " " DISPLAY "COL_CH2 should be HANIA; it is ", c_ch2, " " if (c_num1 NOT = 1002 OR c_ch1 NOT = "MAKIS" OR c_num2 NOT = 4002) then MOVE 0 TO flag END-IF if (c_ch2 NOT = "HANIA" ) then MOVE 0 TO flag END-IF DISPLAY " " *re-initialise host variables MOVE "xxxxxxxxxx" TO c_ch1 MOVE "xxxxxxxxxx" TO c_ch2 MOVE 0 TO c_num1 MOVE 0 TO c_num2 *fetch fourth row DISPLAY "FETCH CLCURS INTO :c_num1, :c_ch1, :c_num2, - " :c_ch2;" * EXEC SQL FETCH CLCURS INTO :c_num1, :c_ch1, :c_num2, :c_ch2 * ; CALL "SUB9" USING SQLCODE SQLSTATE c_num1 c_ch1 c_num2 c_ch2 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY "COL_NUM1 should be 1001; it is ", c_num1, " " DISPLAY "COL_CH1 should be MARIA; it is ", c_ch1, " " DISPLAY "COL_NUM2 should be 4001; it is ", c_num2, " " DISPLAY "COL_CH2 should be RHODES; it is ", c_ch2, " " if (c_num1 NOT = 1001 OR c_ch1 NOT = "MARIA" OR c_num2 NOT = 4001) then MOVE 0 TO flag END-IF if (c_ch2 NOT = "RHODES") then MOVE 0 TO flag END-IF DISPLAY " " *re-initialise host variables MOVE "xxxxxxxxxx" TO c_ch1 MOVE "xxxxxxxxxx" TO c_ch2 MOVE 0 TO c_num1 MOVE 0 TO c_num2 *fetch fifth row DISPLAY "FETCH CLCURS INTO :c_num1, :c_ch1, :c_num2, - " :c_ch2;" * EXEC SQL FETCH CLCURS INTO :c_num1, :c_ch1, :c_num2, :c_ch2 * ; CALL "SUB10" USING SQLCODE SQLSTATE c_num1 c_ch1 c_num2 c_ch2 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY "COL_NUM1 should be 1000; it is ", c_num1, " " DISPLAY "COL_CH1 should be NICKOS; it is ", c_ch1, " " DISPLAY "COL_NUM2 should be 4000; it is ", c_num2, " " DISPLAY "COL_CH2 should be ATHENS; it is ", c_ch2, " " if (c_num1 NOT = 1000 OR c_ch1 NOT = "NICKOS" OR c_num2 NOT = 4000) then MOVE 0 TO flag END-IF if (c_ch2 NOT = "ATHENS") then MOVE 0 TO flag END-IF DISPLAY " " *end fetches *close the cursor and open it again. If the vendor *supports the extension then the inserted row should be *now visible through the cursor DISPLAY "CLOSE CLCURS;" * EXEC SQL CLOSE CLCURS; CALL "SUB11" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " *open the cursor again DISPLAY "OPEN CLCURS;" * EXEC SQL OPEN CLCURS; CALL "SUB3" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " *now fetch and check if the inserted row is visible *initialise host variables MOVE "xxxxxxxxxx" TO c_ch1 MOVE "xxxxxxxxxx" TO c_ch2 MOVE 0 TO c_num1 MOVE 0 TO c_num2 DISPLAY "FETCH CLCURS INTO :c_num1, :c_ch1, :c_num2, - " :c_ch2;" * EXEC SQL FETCH CLCURS INTO :c_num1, :c_ch1, :c_num2, :c_ch2 * ; CALL "SUB13" USING SQLCODE SQLSTATE c_num1 c_ch1 c_num2 c_ch2 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK *since the cursor is declared insensitive with cursor *specification ORDER BY DESC the last row will be *returned first DISPLAY "COL_NUM1 should be 1005; it is ", c_num1, " " DISPLAY "COL_CH1 should be KEVIN; it is ", c_ch1, " " DISPLAY "COL_NUM2 should be 4005; it is ", c_num2, " " DISPLAY "COL_CH2 should be XIOS; it is ", c_ch2, " " *check if the inserted row is visible through the cursor *proceed if not record a NOGO if it is if (c_num1 NOT = 1005 OR c_ch1 NOT = "KEVIN" OR c_num2 NOT = 4005) then MOVE 0 TO flag END-IF if (c_ch2 NOT = "XIOS") then MOVE 0 TO flag END-IF DISPLAY " " *fetch remaining 5 rows, initialising before the host variables MOVE "xxxxxxxxxx" TO c_ch1 MOVE "xxxxxxxxxx" TO c_ch2 MOVE 0 TO c_num1 MOVE 0 TO c_num2 DISPLAY "FETCH CLCURS INTO :c_num1, :c_ch1, :c_num2, - " :c_ch2;" * EXEC SQL FETCH CLCURS INTO :c_num1, :c_ch1, :c_num2, :c_ch2 * ; CALL "SUB14" USING SQLCODE SQLSTATE c_num1 c_ch1 c_num2 c_ch2 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY "COL_NUM1 should be 1004; it is ", c_num1, " " DISPLAY "COL_CH1 should be MORRIS;it is ", c_ch1, " " DISPLAY "COL_NUM2 should be 4004; it is ", c_num2, " " DISPLAY "COL_CH2 should be PARGA; it is ", c_ch2, " " if (c_num1 NOT = 1004 OR c_ch1 NOT = "MORRIS" OR c_num2 NOT = 4004) then MOVE 0 TO flag END-IF if (c_ch2 NOT = "PARGA") then MOVE 0 TO flag END-IF DISPLAY " " *4 remaining MOVE "xxxxxxxxxx" TO c_ch1 MOVE "xxxxxxxxxx" TO c_ch2 MOVE 0 TO c_num1 MOVE 0 TO c_num2 DISPLAY "FETCH CLCURS INTO :c_num1, :c_ch1, :c_num2, - " :c_ch2;" * EXEC SQL FETCH CLCURS INTO :c_num1, :c_ch1, :c_num2, :c_ch2 * ; CALL "SUB15" USING SQLCODE SQLSTATE c_num1 c_ch1 c_num2 c_ch2 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY "COL_NUM1 should be 1003; it is ", c_num1, " " DISPLAY "COL_CH1 should be GEORGE; it is ", c_ch1, " " DISPLAY "COL_NUM2 should be 4003; it is ", c_num2, " " DISPLAY "COL_CH2 should be ARTA; it is ", c_ch2, " " if (c_num1 NOT = 1003 OR c_ch1 NOT = "GEORGE" OR c_num2 NOT = 4003) then MOVE 0 TO flag END-IF if (c_ch2 NOT = "ARTA") then MOVE 0 TO flag END-IF DISPLAY " " *3 remaining MOVE "xxxxxxxxxx" TO c_ch1 MOVE "xxxxxxxxxx" TO c_ch2 MOVE 0 TO c_num1 MOVE 0 TO c_num2 DISPLAY "FETCH CLCURS INTO :c_num1, :c_ch1, :c_num2, - " :c_ch2;" * EXEC SQL FETCH CLCURS INTO :c_num1, :c_ch1, :c_num2, :c_ch2 * ; CALL "SUB16" USING SQLCODE SQLSTATE c_num1 c_ch1 c_num2 c_ch2 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY "COL_NUM1 should be 1002; it is ", c_num1, " " DISPLAY "COL_CH1 should be MAKIS; it is ", c_ch1, " " DISPLAY "COL_NUM2 should be 4002; it is ", c_num2, " " DISPLAY "COL_CH2 should be HANIA; it is ", c_ch2, " " if (c_num1 NOT = 1002 OR c_ch1 NOT = "MAKIS" OR c_num2 NOT = 4002) then MOVE 0 TO flag END-IF if (c_ch2 NOT = "HANIA") then MOVE 0 TO flag END-IF DISPLAY " " *2 remaining MOVE "xxxxxxxxxx" TO c_ch1 MOVE "xxxxxxxxxx" TO c_ch2 MOVE 0 TO c_num1 MOVE 0 TO c_num2 DISPLAY "FETCH CLCURS INTO :c_num1, :c_ch1, :c_num2, - " :c_ch2;" * EXEC SQL FETCH CLCURS INTO :c_num1, :c_ch1, :c_num2, :c_ch2 * ; CALL "SUB17" USING SQLCODE SQLSTATE c_num1 c_ch1 c_num2 c_ch2 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY "COL_NUM1 should be 1001; it is ", c_num1, " " DISPLAY "COL_CH1 should be MARIA; it is ", c_ch1, " " DISPLAY "COL_NUM2 should be 4001; it is ", c_num2, " " DISPLAY "COL_CH2 should be RHODES; it is ", c_ch2, " " if (c_num1 NOT = 1001 OR c_ch1 NOT = "MARIA" OR c_num2 NOT = 4001) then MOVE 0 TO flag END-IF if (c_ch2 NOT = "RHODES") then MOVE 0 TO flag END-IF DISPLAY " " *1 remaining MOVE "xxxxxxxxxx" TO c_ch1 MOVE "xxxxxxxxxx" TO c_ch2 MOVE 0 TO c_num1 MOVE 0 TO c_num2 DISPLAY "FETCH CLCURS INTO :c_num1, :c_ch1, :c_num2, - " :c_ch2;" * EXEC SQL FETCH CLCURS INTO :c_num1, :c_ch1, :c_num2, :c_ch2 * ; CALL "SUB18" USING SQLCODE SQLSTATE c_num1 c_ch1 c_num2 c_ch2 MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY "COL_NUM1 should be 1000; it is ", c_num1, " " DISPLAY "COL_CH1 should be NICKOS; it is ", c_ch1, " " DISPLAY "COL_NUM2 should be 4000; it is ", c_num2, " " DISPLAY "COL_CH2 should be ATHENS it is ", c_ch2, " " if (c_num1 NOT = 1000 OR c_ch1 NOT = "NICKOS" OR c_num2 NOT = 4000) then MOVE 0 TO flag END-IF if (c_ch2 NOT = "ATHENS") then MOVE 0 TO flag END-IF DISPLAY " " *end fetches *now close the cursor DISPLAY "CLOSE CLCURS;" * EXEC SQL CLOSE CLCURS; CALL "SUB19" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " *restore table CL_STANDARD in its original state DISPLAY "ROLLBACK WORK;" * EXEC SQL ROLLBACK WORK; CALL "SUB20" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD PERFORM CHCKOK DISPLAY " " *record results if ( flag = 1 ) then DISPLAY " xts725.mco *** pass *** " * EXEC SQL INSERT INTO CTS1.TESTREPORT * VALUES('7025','pass','MCO'); CALL "SUB21" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD DISPLAY "SQL extension INSENSITIVE cursor executed - " successfully" DISPLAY "Vendor must demonstrate Intermediate Flagger - " WARNING" else DISPLAY " xts725.mco *** NOGO *** " * EXEC SQL INSERT INTO CTS1.TESTREPORT * VALUES('7025','NOGO','MCO'); CALL "SUB22" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD DISPLAY "Vendor does not support fully " DISPLAY "Intermediate SQL extension " DISPLAY "Support for Insensitive cursors is not required" END-IF DISPLAY "========================================" *BAK : Check again in order to insert a third option for fail *DWF: ??? * EXEC SQL COMMIT WORK; CALL "SUB23" USING SQLCODE SQLSTATE MOVE SQLCODE TO SQL-COD ******************** END TEST7025 ******************** **** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0 STOP RUN. * **** Procedures for PERFORM statements *Test SQLCODE and SQLSTATE for normal completion. CHCKOK. DISPLAY "SQLCODE should be 0; its value is ", SQL-COD DISPLAY "SQLSTATE should be 00000; its value is ", SQLSTATE PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (SQLCODE NOT = 0 OR NORMSQ NOT = "00000") then MOVE 0 TO flag END-IF if (NORMSQ = "00000" AND NORMSQ NOT = SQLSTATE) then DISPLAY "Valid implementation-defined SQLSTATE accepted." END-IF . NOSUBCLASS. *This routine replaces valid implementation-defined *subclasses with 000. This replacement equates valid *implementation-defined subclasses with the 000 value *expected by the test case; otherwise the test will fail. *After calling NOSUBCLASS, NORMSQ will be tested * SQLSTATE will be printed. MOVE SQLSTATE TO NORMSQ MOVE 3 TO norm1 *subclass begins in position 3 of char array NORMSQ *valid subclass begins with 5-9, I-Z, end of ALPNUM table PERFORM VARYING norm2 FROM 14 BY 1 UNTIL norm2 > 36 if (NORMSQX(norm1) = ALPNUM(norm2)) then MOVE "0" TO NORMSQX(norm1) END-IF END-PERFORM *Quit if NORMSQ is unchanged. Subclass is not impl.-def. *Changed NORMSQ means implementation-defined subclass, *so proceed to zero it out, if valid (0-9,A-Z) if (NORMSQ = SQLSTATE) then GO TO EXIT-NOSUBCLASS END-IF MOVE 4 TO norm1 *examining position 4 of char array NORMSQ *valid characters are 0-9, A-Z PERFORM VARYING norm2 FROM 1 BY 1 UNTIL norm2 > 36 if (NORMSQX(norm1) = ALPNUM(norm2)) then MOVE "0" TO NORMSQX(norm1) END-IF END-PERFORM MOVE 5 TO norm1 *valid characters are 0-9, A-Z *examining position 5 of char array NORMSQ PERFORM VARYING norm2 FROM 1 BY 1 UNTIL norm2 > 36 if (NORMSQX(norm1) = ALPNUM(norm2)) then MOVE "0" TO NORMSQX(norm1) END-IF END-PERFORM *implementation-defined subclasses are allowed for warnings *(class = 01). These equate to successful completion *SQLSTATE values of 00000. *Reference SQL-92 4.28 SQL-transactions, paragraph 2 if (NORMSQX(1) = "0" AND NORMSQX(2) = "1") then MOVE "0" TO NORMSQX(2) END-IF . EXIT-NOSUBCLASS. EXIT. ¤ 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.Bot Zugriff |
