| products/Sources/formale Sprachen/COBOL/Test-Suite/SQL P/dml1-99/ |
|
Quellcode-Bibliothek© Kompilation durch diese Firma[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]Datei: argumenttypenames001.java Sprache: Cobol |
|
||||||
|
IDENTIFICATION DIVISION.
PROGRAM-ID. DML083. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. xyz. OBJECT-COMPUTER. xyz. DATA DIVISION. WORKING-STORAGE SECTION. * EMBEDDED COBOL (file "DML083.PCO") **************************************************************** * * COMMENT SECTION * * DATE 1992/07/13 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. * * DML083.PCO * WRITTEN BY: DAVID W. FLATER * * THIS ROUTINE TESTS THE SQLSTATE STATUS CODE. * * REFERENCES * ANSI SQL-1992 * 22.1 SQLSTATE * **************************************************************** EXEC SQL BEGIN DECLARE SECTION END-EXEC 01 uid PIC X(18). 01 uidx PIC X(18). 01 c1 PIC S9(4) DISPLAY SIGN LEADING SEPARATE. 01 ch1 PIC X(1). 01 ch22 PIC X(22). 01 DECML-12-3 PIC S9(12)V999 DISPLAY SIGN LEADING SEPARATE. 01 LONG1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE. 01 SQLCODE PIC S9(9) COMP. 01 SQLSTATE PIC X(5). EXEC SQL END DECLARE SECTION END-EXEC 01 DISP-12-3 PIC -(13).999 . 01 ii PIC S9(9) DISPLAY SIGN LEADING SEPARATE. 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 NR-TAB. 05 NORMSQ 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 wflag PIC S9(9) DISPLAY SIGN LEADING SEPARATE. 01 SQL-COD PIC S9(9) DISPLAY SIGN LEADING SEPARATE. PROCEDURE DIVISION. P0. MOVE "SCHANZLE " TO uid CALL "AUTHID" USING uid MOVE "not logged in, not" TO uidx EXEC SQL SELECT USER INTO :uidx FROM HU.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 MOVE 1 TO flag DISPLAY "SQL Test Suite, V6.0, Embedded COBOL, dml083.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 TEST0496 ******************* MOVE 1 TO flag DISPLAY " TEST0496 " DISPLAY "SQLSTATE = 22002: data exception " DISPLAY "(null value, no indicator parameter)" DISPLAY "Reference ANSI SQL-1992 section 9.1" DISPLAY "Retrieval assignment, General Rule #1" DISPLAY " - - - - - - - - - - - - - - - - - - -" DISPLAY "DELETE FROM FOUR_TYPES;" EXEC SQL DELETE FROM FOUR_TYPES END-EXEC MOVE SQLCODE TO SQL-COD MOVE "x" TO SQLSTATE DISPLAY "INSERT INTO FOUR_TYPES VALUES - " (NULL,NULL,4.1,NULL);" EXEC SQL INSERT INTO FOUR_TYPES VALUES (NULL,NULL,4.1,NULL) END-EXEC MOVE SQLCODE TO SQL-COD DISPLAY "SQLCODE should be 0; its value is ", SQL-COD DISPLAY "SQLSTATE should be '00000'; its value is ", SQLSTATE DISPLAY " " PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (SQLCODE NOT = 0 OR NR-TAB NOT = "00000") then MOVE 0 TO flag END-IF *exact numeric test case - single row select DISPLAY " " MOVE 66 TO SQLCODE MOVE "x" TO SQLSTATE DISPLAY "SELECT T_INT INTO :c1 FROM FOUR_TYPES" DISPLAY " WHERE T_DECIMAL = 4.1;" EXEC SQL SELECT T_INT INTO :c1 FROM FOUR_TYPES WHERE T_DECIMAL = 4.1 END-EXEC MOVE SQLCODE TO SQL-COD DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD DISPLAY "SQLSTATE should be '22002'; its value is ", SQLSTATE if (SQLCODE NOT < 0 OR SQLSTATE NOT = "22002") then MOVE 0 TO flag END-IF *numeric test case - single row select DISPLAY " " MOVE 66 TO SQLCODE MOVE "x" TO SQLSTATE DISPLAY "SELECT T_INT + 1.222 INTO :DECML-12-3" DISPLAY " FROM FOUR_TYPES WHERE T_DECIMAL = 4.1;" EXEC SQL SELECT T_INT + 1.222 INTO :DECML-12-3 FROM FOUR_TYPES WHERE T_DECIMAL = 4.1 END-EXEC MOVE SQLCODE TO SQL-COD DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD DISPLAY "SQLSTATE should be '22002'; its value is ", SQLSTATE if (SQLCODE NOT < 0 OR SQLSTATE NOT = "22002") then MOVE 0 TO flag END-IF *character data test case - cursor DISPLAY " " MOVE 66 TO SQLCODE MOVE "x" TO SQLSTATE DISPLAY "DECLARE CHARCHAR CURSOR FOR" DISPLAY " SELECT T_CHAR FROM FOUR_TYPES" DISPLAY " WHERE T_DECIMAL = 4.1;" DISPLAY "OPEN CHARCHAR;" DISPLAY "FETCH CHARCHAR INTO :ch22;" EXEC SQL DECLARE CHARCHAR CURSOR FOR SELECT T_CHAR FROM FOUR_TYPES WHERE T_DECIMAL = 4.1 END-EXEC EXEC SQL OPEN CHARCHAR END-EXEC MOVE SQLCODE TO SQL-COD EXEC SQL FETCH CHARCHAR INTO :ch22 END-EXEC MOVE SQLCODE TO SQL-COD DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD DISPLAY "SQLSTATE should be '22002'; its value is ", SQLSTATE if (SQLCODE NOT < 0 OR SQLSTATE NOT = "22002") then MOVE 0 TO flag END-IF EXEC SQL ROLLBACK WORK END-EXEC MOVE SQLCODE TO SQL-COD if ( flag = 1 ) then DISPLAY " *** pass *** " EXEC SQL INSERT INTO HU.TESTREPORT VALUES('0496','pass','PCO') END-EXEC MOVE SQLCODE TO SQL-COD else DISPLAY " dml083.pco *** fail *** " EXEC SQL INSERT INTO HU.TESTREPORT VALUES('0496','fail','PCO') END-EXEC MOVE SQLCODE TO SQL-COD COMPUTE errcnt = errcnt + 1 END-IF DISPLAY "===============================================" EXEC SQL COMMIT WORK END-EXEC MOVE SQLCODE TO SQL-COD ******************** END TEST0496 ******************** ******************** BEGIN TEST0498 ******************* MOVE 1 TO flag DISPLAY " TEST0498 " DISPLAY "SQLSTATE = 22001: data exception " DISPLAY "(string data, right truncation)" DISPLAY " section 9.2 DISPLAY " section 3.3.4.1 Exceptions" DISPLAY " - - - - - - - - - - - - - - - - - - -" MOVE "x" TO SQLSTATE DISPLAY "INSERT INTO HU.STAFF VALUES" DISPLAY "('E6','Earl Brown',11,'Claggetsville Maryland');" EXEC SQL INSERT INTO HU.STAFF VALUES ('E6','Earl Brown',11,'Claggetsville Maryland') END-EXEC MOVE SQLCODE TO SQL-COD DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD DISPLAY "SQLSTATE should be '22001'; its value is ", SQLSTATE *Truncation on a store assignment is an exception, so it *should be accompanied by a negative SQLCODE. if (SQLCODE NOT < 0 OR SQLSTATE NOT = "22001") then MOVE 0 TO flag END-IF DISPLAY " " MOVE "x" TO SQLSTATE MOVE "Claggetsville Maryland" TO ch22 DISPLAY "INSERT INTO HU.STAFF VALUES" DISPLAY "('E7','Ella Brown',12,:ch22);" DISPLAY "-- where ch22 = ", ch22 EXEC SQL INSERT INTO HU.STAFF VALUES ('E7','Ella Brown',12,:ch22) END-EXEC MOVE SQLCODE TO SQL-COD DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD DISPLAY "SQLSTATE should be '22001'; its value is ", SQLSTATE if (SQLCODE NOT < 0 OR SQLSTATE NOT = "22001") then MOVE 0 TO flag END-IF DISPLAY " " COMPUTE c1 = -1 DISPLAY "SELECT COUNT(*) INTO :c1 FROM HU.STAFF;" EXEC SQL SELECT COUNT(*) INTO :c1 FROM HU.STAFF END-EXEC MOVE SQLCODE TO SQL-COD DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD DISPLAY "c1 should be 5; its value is ", c1 if (SQLCODE NOT = 0 OR c1 NOT = 5) then MOVE 0 TO flag END-IF EXEC SQL ROLLBACK WORK END-EXEC MOVE SQLCODE TO SQL-COD if ( flag = 1 ) then DISPLAY " *** pass *** " EXEC SQL INSERT INTO HU.TESTREPORT VALUES('0498','pass','PCO') END-EXEC MOVE SQLCODE TO SQL-COD else DISPLAY " dml083.pco *** fail *** " EXEC SQL INSERT INTO HU.TESTREPORT VALUES('0498','fail','PCO') END-EXEC MOVE SQLCODE TO SQL-COD COMPUTE errcnt = errcnt + 1 END-IF DISPLAY "===============================================" EXEC SQL COMMIT WORK END-EXEC MOVE SQLCODE TO SQL-COD ******************** END TEST0498 ******************** ******************** BEGIN TEST0500 ******************* MOVE 1 TO flag DISPLAY " TEST0500 " DISPLAY "SQLSTATE = 01003: warning " DISPLAY "(null value eliminated in set fnunction)" DISPLAY "Reference ANSI SQL-1992 section 6.5" DISPLAY " DISPLAY " General Rule #1b" DISPLAY " - - - - - - - - - - - - - - - - - - -" DISPLAY " " DISPLAY "DELETE FROM HU.HH;" EXEC SQL DELETE FROM HU.HH END-EXEC MOVE SQLCODE TO SQL-COD MOVE "x" TO SQLSTATE DISPLAY "INSERT INTO HU.HH VALUES (3);" EXEC SQL INSERT INTO HU.HH VALUES (3) END-EXEC MOVE SQLCODE TO SQL-COD DISPLAY "SQLCODE should be 0; its value is ", SQL-COD DISPLAY "SQLSTATE should be '00000'; its value is ", SQLSTATE DISPLAY " " PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (SQLCODE NOT = 0 OR NR-TAB NOT = "00000") then MOVE 0 TO flag END-IF DISPLAY " " MOVE "x" TO SQLSTATE DISPLAY "INSERT INTO HU.HH VALUES (NULL);" EXEC SQL INSERT INTO HU.HH VALUES (NULL) END-EXEC MOVE SQLCODE TO SQL-COD DISPLAY "SQLCODE should be 0; its value is ", SQL-COD DISPLAY "SQLSTATE should be '00000'; its value is ", SQLSTATE DISPLAY " " PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (SQLCODE NOT = 0 OR NR-TAB NOT = "00000") then MOVE 0 TO flag END-IF DISPLAY " " MOVE "x" TO SQLSTATE COMPUTE c1 = -1 DISPLAY "SELECT AVG(SMALLTEST) INTO :c1 FROM HU.HH;" EXEC SQL SELECT AVG(SMALLTEST) INTO :c1 FROM HU.HH END-EXEC MOVE SQLCODE TO SQL-COD DISPLAY "SQLCODE should be >= 0; its value is ", SQL-COD DISPLAY "SQLSTATE should be '01003'; its value is ", SQLSTATE DISPLAY "c1 should be 3; its value is ", c1 if (SQLCODE < 0 OR SQLSTATE NOT = "01003" OR c1 NOT = 3) then MOVE 0 TO flag END-IF DISPLAY " " DISPLAY "UPDATE HU.STAFF SET GRADE = NULL" DISPLAY " WHERE GRADE = 13;" EXEC SQL UPDATE HU.STAFF SET GRADE = NULL WHERE GRADE = 13 END-EXEC MOVE SQLCODE TO SQL-COD DISPLAY " " MOVE "x" TO SQLSTATE COMPUTE DECML-12-3 = -1 DISPLAY "SELECT AVG(GRADE) INTO :DECML-12-3 FROM HU.STAFF" DISPLAY " WHERE CITY = 'Vienna';" EXEC SQL SELECT AVG(GRADE) INTO :DECML-12-3 FROM HU.STAFF WHERE CITY = 'Vienna' END-EXEC MOVE SQLCODE TO SQL-COD DISPLAY "SQLCODE should be >= 0; its value is ", SQL-COD DISPLAY "SQLSTATE should be '01003'; its value is ", SQLSTATE MOVE DECML-12-3 TO DISP-12-3 DISPLAY "DECML-12-3 should be 10; its value is ", DISP-12-3 if (SQLCODE < 0 OR SQLSTATE NOT = "01003") then MOVE 0 TO flag END-IF if (DECML-12-3 > 11 OR DECML-12-3 < 9) then MOVE 0 TO flag END-IF DISPLAY " " MOVE "x" TO SQLSTATE COMPUTE c1 = -1 DISPLAY "SELECT SUM(DISTINCT GRADE) INTO :c1 FROM HU.STAFF" EXEC SQL SELECT SUM(DISTINCT GRADE) INTO :c1 FROM HU.STAFF END-EXEC MOVE SQLCODE TO SQL-COD DISPLAY "SQLCODE should be >= 0; its value is ", SQL-COD DISPLAY "SQLSTATE should be '01003'; its value is ", SQLSTATE DISPLAY "c1 should be 22; its value is ", c1 if (SQLCODE < 0 OR SQLSTATE NOT = "01003" OR c1 NOT = 22) then MOVE 0 TO flag END-IF DISPLAY " " MOVE "x" TO SQLSTATE DISPLAY "INSERT INTO HU.HH " DISPLAY " SELECT MAX(GRADE) FROM HU.STAFF;" EXEC SQL INSERT INTO HU.HH SELECT MAX(GRADE) FROM HU.STAFF END-EXEC MOVE SQLCODE TO SQL-COD DISPLAY "SQLCODE should be >= 0; its value is ", SQL-COD DISPLAY "SQLSTATE should be '01003'; its value is ", SQLSTATE if (SQLCODE < 0 OR SQLSTATE NOT = "01003") then MOVE 0 TO flag END-IF DISPLAY " " MOVE "x" TO SQLSTATE DISPLAY "DELETE FROM HU.HH WHERE SMALLTEST < " DISPLAY " (SELECT MIN(GRADE) FROM HU.STAFF" DISPLAY " WHERE CITY = 'Vienna');" EXEC SQL DELETE FROM HU.HH WHERE SMALLTEST < (SELECT MIN(GRADE) FROM HU.STAFF WHERE CITY = 'Vienna') END-EXEC MOVE SQLCODE TO SQL-COD DISPLAY "SQLCODE should be >= 0; its value is ", SQL-COD DISPLAY "SQLSTATE should be '01003'; its value is ", SQLSTATE if (SQLCODE < 0 OR SQLSTATE NOT = "01003") then MOVE 0 TO flag END-IF *Begin maligned code segment MOVE 0 TO wflag DISPLAY " " DISPLAY "DECLARE SKIER CURSOR FOR " DISPLAY " SELECT CITY, COUNT(DISTINCT GRADE) FROM - " HU.STAFF" DISPLAY " GROUP BY CITY" DISPLAY " ORDER BY CITY DESC;" EXEC SQL DECLARE SKIER CURSOR FOR SELECT CITY, COUNT(DISTINCT GRADE) FROM HU.STAFF GROUP BY CITY ORDER BY CITY DESC END-EXEC DISPLAY "OPEN SKIER;" EXEC SQL OPEN SKIER END-EXEC MOVE SQLCODE TO SQL-COD PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (NR-TAB = "01003") then MOVE 1 TO wflag END-IF DISPLAY "SQLCODE should be >= 0; its value is ", SQL-COD if (SQLCODE < 0) then MOVE 0 TO flag END-IF DISPLAY "SQLSTATE should be 00000 or 01003; its value is ", SQLSTATE if (NR-TAB NOT = "00000" AND NR-TAB NOT = "01003") then MOVE 0 TO flag END-IF if (NR-TAB = "00000" AND NR-TAB NOT = SQLSTATE) then DISPLAY "Valid implementation-defined SQLSTATE accepted." END-IF DISPLAY " " MOVE "xxxxx" TO SQLSTATE MOVE "NOWHERE " TO ch22 COMPUTE c1 = -1 DISPLAY "FETCH SKIER INTO :ch22, :c1;" EXEC SQL FETCH SKIER INTO :ch22, :c1 END-EXEC MOVE SQLCODE TO SQL-COD DISPLAY "ch22 should be 'Vienna '; its value - " is ", ch22 DISPLAY "c1 should be 1; its value is ", c1 if (c1 NOT = 1 OR ch22 NOT = "Vienna - " ") then MOVE 0 TO flag END-IF PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (NR-TAB = "01003") then MOVE 1 TO wflag END-IF DISPLAY "SQLCODE should be >= 0; its value is ", SQL-COD if (SQLCODE < 0) then MOVE 0 TO flag END-IF DISPLAY "SQLSTATE should be 00000 or 01003; its value is ", SQLSTATE if (NR-TAB NOT = "00000" AND NR-TAB NOT = "01003") then MOVE 0 TO flag END-IF if (NR-TAB = "00000" AND NR-TAB NOT = SQLSTATE) then DISPLAY "Valid implementation-defined SQLSTATE accepted." END-IF DISPLAY " " MOVE "xxxxx" TO SQLSTATE MOVE "NOWHERE " TO ch22 COMPUTE c1 = -1 DISPLAY "FETCH SKIER INTO :ch22, :c1;" EXEC SQL FETCH SKIER INTO :ch22, :c1 END-EXEC MOVE SQLCODE TO SQL-COD DISPLAY "ch22 should be 'Deale '; its value - " is ", ch22 DISPLAY "c1 should be 1; its value is ", c1 if (c1 NOT = 1 OR ch22 NOT = "Deale - " ") then MOVE 0 TO flag END-IF PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (NR-TAB = "01003") then MOVE 1 TO wflag END-IF DISPLAY "SQLCODE should be >= 0; its value is ", SQL-COD if (SQLCODE < 0) then MOVE 0 TO flag END-IF DISPLAY "SQLSTATE should be 00000 or 01003; its value is ", SQLSTATE if (NR-TAB NOT = "00000" AND NR-TAB NOT = "01003") then MOVE 0 TO flag END-IF if (NR-TAB = "00000" AND NR-TAB NOT = SQLSTATE) then DISPLAY "Valid implementation-defined SQLSTATE accepted." END-IF DISPLAY " " MOVE "xxxxx" TO SQLSTATE MOVE "NOWHERE " TO ch22 COMPUTE c1 = -1 DISPLAY "FETCH SKIER INTO :ch22, :c1;" EXEC SQL FETCH SKIER INTO :ch22, :c1 END-EXEC MOVE SQLCODE TO SQL-COD DISPLAY "ch22 should be 'Akron '; its value - " is ", ch22 DISPLAY "c1 should be 0; its value is ", c1 if (c1 NOT = 0 OR ch22 NOT = "Akron - " ") then MOVE 0 TO flag END-IF PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS if (NR-TAB = "01003") then MOVE 1 TO wflag END-IF DISPLAY "SQLCODE should be >= 0; its value is ", SQL-COD if (SQLCODE < 0) then MOVE 0 TO flag END-IF DISPLAY "SQLSTATE should be 00000 or 01003; its value is ", SQLSTATE if (NR-TAB NOT = "00000" AND NR-TAB NOT = "01003") then MOVE 0 TO flag END-IF if (NR-TAB = "00000" AND NR-TAB NOT = SQLSTATE) then DISPLAY "Valid implementation-defined SQLSTATE accepted." END-IF DISPLAY " " DISPLAY "We should have gotten at least one 01003 warning." if (wflag = 0) then DISPLAY "But we didn't." MOVE 0 TO flag else DISPLAY "Indeed we did." END-IF EXEC SQL ROLLBACK WORK END-EXEC MOVE SQLCODE TO SQL-COD if ( flag = 1 ) then DISPLAY " *** pass *** " EXEC SQL INSERT INTO HU.TESTREPORT VALUES('0500','pass','PCO') END-EXEC MOVE SQLCODE TO SQL-COD else DISPLAY " dml083.pco *** fail *** " EXEC SQL INSERT INTO HU.TESTREPORT VALUES('0500','fail','PCO') END-EXEC MOVE SQLCODE TO SQL-COD COMPUTE errcnt = errcnt + 1 END-IF DISPLAY "===============================================" EXEC SQL COMMIT WORK END-EXEC MOVE SQLCODE TO SQL-COD ******************** END TEST0500 ******************** ******************** BEGIN TEST0501 ******************* MOVE 1 TO flag DISPLAY " TEST0501 " DISPLAY "SQLSTATE = 01004: warning " DISPLAY "(string data, right truncation)" DISPLAY "Reference ANSI SQL-1992," DISPLAY " section 9.1 DISPLAY " section 3.3.4.1 Exceptions" DISPLAY " - - - - - - - - - - - - - - - - - - -" DISPLAY " " MOVE "x" TO SQLSTATE DISPLAY "SELECT EMPNAME INTO :ch1 FROM HU.STAFF" DISPLAY " WHERE EMPNUM = 'E3';" EXEC SQL SELECT EMPNAME INTO :ch1 FROM HU.STAFF WHERE EMPNUM = 'E3' END-EXEC MOVE SQLCODE TO SQL-COD DISPLAY "SQLCODE should be >= 0; its value is ", SQL-COD DISPLAY "SQLSTATE should be '01004'; its value is ", SQLSTATE DISPLAY "ch1 should be 'C'; its value is ", ch1 if (SQLCODE < 0 OR SQLSTATE NOT = "01004") then MOVE 0 TO flag END-IF if (ch1 NOT = "C") then MOVE 0 TO flag END-IF DISPLAY " " MOVE "x" TO SQLSTATE DISPLAY "DECLARE JOHNS CURSOR FOR" DISPLAY " SELECT EMPNAME FROM HU.STAFF" DISPLAY " WHERE EMPNUM = 'E3';" DISPLAY "OPEN JOHNS;" DISPLAY "FETCH JOHNS INTO :ch1;" EXEC SQL DECLARE JOHNS CURSOR FOR SELECT EMPNAME FROM HU.STAFF WHERE EMPNUM = 'E3' END-EXEC EXEC SQL OPEN JOHNS END-EXEC MOVE SQLCODE TO SQL-COD EXEC SQL FETCH JOHNS INTO :ch1 END-EXEC MOVE SQLCODE TO SQL-COD DISPLAY "SQLCODE should be >= 0; its value is ", SQL-COD DISPLAY "SQLSTATE should be '01004'; its value is ", SQLSTATE if (SQLCODE < 0 OR SQLSTATE NOT = "01004") then MOVE 0 TO flag END-IF DISPLAY "ch1 should be 'C'; its value is ", ch1 if (ch1 NOT = "C") then MOVE 0 TO flag END-IF EXEC SQL ROLLBACK WORK END-EXEC MOVE SQLCODE TO SQL-COD if ( flag = 1 ) then DISPLAY " *** pass *** " EXEC SQL INSERT INTO HU.TESTREPORT VALUES('0501','pass','PCO') END-EXEC MOVE SQLCODE TO SQL-COD else DISPLAY " dml083.pco *** fail *** " EXEC SQL INSERT INTO HU.TESTREPORT VALUES('0501','fail','PCO') END-EXEC MOVE SQLCODE TO SQL-COD COMPUTE errcnt = errcnt + 1 END-IF DISPLAY "===============================================" EXEC SQL COMMIT WORK END-EXEC MOVE SQLCODE TO SQL-COD ******************** END TEST0501 ******************** **** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0 STOP RUN. * **** Procedures for PERFORM statements 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 NR-TAB MOVE 3 TO norm1 *subclass begins in position 3 of char array NORMSQ MOVE 14 TO norm2 PERFORM P90 UNTIL norm2 > 36 if (NR-TAB = SQLSTATE) then GO TO EXIT-NOSUBCLASS END-IF *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) MOVE 4 TO norm1 *examining position 4 of char array NORMSQ MOVE 1 TO norm2 PERFORM P89 UNTIL norm2 > 36 MOVE 5 TO norm1 *examining position 5 of char array NORMSQ MOVE 1 TO norm2 PERFORM P88 UNTIL norm2 > 36 *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 (NORMSQ(1) = "0" AND NORMSQ(2) = "1") then MOVE "0" TO NORMSQ(2) END-IF GO TO EXIT-NOSUBCLASS . P90. *valid subclass begins with 5-9, I-Z, end of ALPNUM table if (NORMSQ(norm1) = ALPNUM(norm2)) then MOVE "0" TO NORMSQ(norm1) END-IF ADD 1 TO norm2 . P89. *valid characters are 0-9, A-Z if (NORMSQ(norm1) = ALPNUM(norm2)) then MOVE "0" TO NORMSQ(norm1) END-IF ADD 1 TO norm2 . P88. *valid characters are 0-9, A-Z if (NORMSQ(norm1) = ALPNUM(norm2)) then MOVE "0" TO NORMSQ(norm1) END-IF ADD 1 TO norm2 . EXIT-NOSUBCLASS. EXIT. ¤ Dauer der Verarbeitung: 0.41 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 |
