|
Quellcode-Bibliothek
© Kompilation durch diese Firma
[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]
Datei:
dml098.mco
Sprache: Cobol
|
|
IDENTIFICATION DIVISION.
PROGRAM-ID. DML084.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. xyz.
OBJECT-COMPUTER. xyz.
DATA DIVISION.
WORKING-STORAGE SECTION.
* Standard COBOL (file "DML084.SCO") calling SQL
* procedures in file "DML084.MCO".
* STANDARD COBOL (file "DML084.SCO")
****************************************************************
*
* COMMENT SECTION
*
* DATE 1992/07/14 STANDARD 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.
*
* DML084.SCO
* 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 ct1 PIC X(2).
01 tmpcnt PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
* EXEC SQL END DECLARE SECTION END-EXEC
01 ii PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 SQLCODE PIC S9(9) COMP.
01 SQLSTATE PIC X(5).
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 SQLST1 PIC X(5).
01 SQLST2 PIC X(5).
01 SQLST3 PIC X(5).
01 SQLST4 PIC X(5).
01 SQLST5 PIC X(5).
01 SQLCD1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 SQLCD2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 SQLCD3 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 SQLCD4 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
01 SQLCD5 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
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 "SCHANZLE" TO uid
CALL "AUTHID" USING uid
MOVE "not logged in, not" TO uidx
* EXEC SQL SELECT USER INTO :uidx FROM HU.ECCO;
CALL "SUB1" USING SQLCODE SQLSTATE uidx
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, Standard COBOL, dml084.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 TEST0503 *******************
MOVE 1 TO flag
DISPLAY " TEST0503 "
DISPLAY "SQLSTATE = 42000: syntax error or access rule vio.
- " 1"
DISPLAY "Note: VALID implementation-defined subclass will
- " be"
DISPLAY " accepted instead of no-subclass value of 000
- " "
DISPLAY "Reference ANSI SQL-1992,"
DISPLAY " section 6.3 Access Rule #1"
DISPLAY " section 3.3.4.3 Terms denoting rule
- " requirements"
DISPLAY " section 3.3.4.4 Rule evaluation order"
DISPLAY " - - - - - - - - - - - - - - - - - - -"
DISPLAY "Test numbers 0503 and 0504 check for SQLSTATE"
DISPLAY "42000 on syntax errors and access violations."
DISPLAY "SQL-92 permits, but does not require, an"
DISPLAY "implementation to achieve a high level of security"
DISPLAY "by returning the same error for an access"
DISPLAY "violation as for a reference to a non-existent"
DISPLAY "table. This test exercises several different"
DISPLAY "types of syntax errors and access violations. If"
DISPLAY "you are trying for a high security level, please"
DISPLAY "insure that the compilation AND the run time"
DISPLAY "behavior of all these errors are"
DISPLAY "indistinguishable."
DISPLAY " "
DISPLAY "For minimal SQL-92 conformance, each run time"
DISPLAY "error must produce SQLSTATE 42000 or 42 with some"
DISPLAY "implementor-defined subclass. The subclass can"
DISPLAY "be different for each error. Compile time errors"
DISPLAY "are also permissible."
DISPLAY " "
DISPLAY " "
DISPLAY " "
DISPLAY " "
*HU.UPUNIQ has a row (1,'A'), but SCHANZLE has no privileges
MOVE 0 TO SQLCODE
MOVE "x" TO ct1
MOVE "x" TO SQLSTATE
DISPLAY "SELECT COL2 INTO :ct1 FROM HU.UPUNIQ WHERE NUMKEY
- " = 1;"
* EXEC SQL SELECT COL2 INTO :ct1 FROM HU.UPUNIQ WHERE NUMKEY
* = 1;
CALL "SUB2" USING SQLCODE SQLSTATE ct1
MOVE SQLCODE TO SQL-COD
MOVE SQLSTATE TO SQLST1
MOVE SQLCODE TO SQLCD1
DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
DISPLAY "SQLSTATE should be '42000'; its value is ",
SQLSTATE
DISPLAY "ct1 should NOT be 'A '; its value is ", ct1
if (SQLCODE NOT < 0 OR ct1 = "A ") then
MOVE 0 TO flag
END-IF
PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
if (NR-TAB NOT = "42000") then
MOVE 0 TO flag
END-IF
*SCHANZLE has no privileges on table HU.UPUNIQ - attempt UPDATE
DISPLAY " "
MOVE 0 TO SQLCODE
MOVE "x" TO SQLSTATE
DISPLAY "UPDATE HU.UPUNIQ SET COL2 = 'xx';"
* EXEC SQL UPDATE HU.UPUNIQ SET COL2 = 'xx';
CALL "SUB3" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
MOVE SQLSTATE TO SQLST2
MOVE SQLCODE TO SQLCD2
DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
DISPLAY "SQLSTATE should be '42000'; its value is ",
SQLSTATE
PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
if (SQLCODE NOT < 0 OR NR-TAB NOT = "42000") then
MOVE 0 TO flag
END-IF
*SCHANZLE has no privileges on table HU.UPUNIQ - attempt DELETE
DISPLAY " "
MOVE 0 TO SQLCODE
MOVE "x" TO SQLSTATE
DISPLAY "DELETE FROM HU.UPUNIQ;"
* EXEC SQL DELETE FROM HU.UPUNIQ;
CALL "SUB4" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
MOVE SQLSTATE TO SQLST3
MOVE SQLCODE TO SQLCD3
DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
DISPLAY "SQLSTATE should be '42000'; its value is ",
SQLSTATE
PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
if (SQLCODE NOT < 0 OR NR-TAB NOT = "42000") then
MOVE 0 TO flag
END-IF
*SCHANZLE has no privileges on table HU.UPUNIQ - attempt insert
DISPLAY " "
MOVE 0 TO SQLCODE
MOVE "x" TO SQLSTATE
DISPLAY "INSERT INTO HU.UPUNIQ VALUES (9,'M');"
* EXEC SQL INSERT INTO HU.UPUNIQ VALUES (9,'M');
CALL "SUB5" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
MOVE SQLSTATE TO SQLST4
MOVE SQLCODE TO SQLCD4
DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
DISPLAY "SQLSTATE should be '42000'; its value is ",
SQLSTATE
PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
if (SQLCODE NOT < 0 OR NR-TAB NOT = "42000") then
MOVE 0 TO flag
END-IF
*Subtest 0503e begins.
*If it will not compile, save error message
*and then delete the subtest with TEd "hooks".
*Privilege violation in 'inessential part' - middle subquery
COMPUTE tmpcnt = -1
DISPLAY " "
MOVE 0 TO SQLCODE
MOVE "x" TO SQLSTATE
DISPLAY "SELECT COUNT(*) INTO :tmpcnt FROM HU.STAFF"
DISPLAY "WHERE GRADE <"
DISPLAY " (SELECT MAX(HOURS) FROM HU.WORKS)"
DISPLAY "OR GRADE >"
DISPLAY " (SELECT MAX(NUMKEY) FROM HU.UPUNIQ)"
DISPLAY "OR GRADE + 100 >"
DISPLAY " (SELECT MIN(HOURS) FROM HU.WORKS);"
* EXEC SQL SELECT COUNT(*) INTO :tmpcnt FROM HU.STAFF
* WHERE GRADE <
* (SELECT MAX(HOURS) FROM HU.WORKS)
* OR GRADE >
* (SELECT MAX(NUMKEY) FROM HU.UPUNIQ)
* OR GRADE + 100 >
* (SELECT MIN(HOURS) FROM HU.WORKS);
CALL "SUB6" USING SQLCODE SQLSTATE tmpcnt
MOVE SQLCODE TO SQL-COD
MOVE SQLSTATE TO SQLST5
MOVE SQLCODE TO SQLCD5
DISPLAY "tmpcnt should not be 5; its value is ", tmpcnt
DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
DISPLAY "SQLSTATE should be '42000'; its value is ",
SQLSTATE
PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
if (tmpcnt = 5 OR SQLCODE NOT < 0 OR NR-TAB NOT =
"42000") then
MOVE 0 TO flag
END-IF
*Subtest 0503e ends
*Subtest 0503f begins.
*If it will not compile, save error message
*and then delete the subtest with TEd "hooks".
*Privilege violation AND syntax error (column 2 is CHAR(2))
DISPLAY " "
MOVE 0 TO SQLCODE
MOVE "x" TO SQLSTATE
DISPLAY "INSERT INTO HU.UPUNIQ VALUES (13,44);"
* EXEC SQL INSERT INTO HU.UPUNIQ VALUES (13,44);
CALL "SUB7" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
DISPLAY "SQLSTATE should be '42000'; its value is ",
SQLSTATE
PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
if (SQLCODE NOT < 0 OR NR-TAB NOT = "42000") then
MOVE 0 TO flag
END-IF
if (SQLCODE NOT = SQLCD4 OR SQLSTATE NOT = SQLST4)
then
DISPLAY "Optional security note:"
DISPLAY "Different message for access violation and "
DISPLAY " access violation with syntax error (CHAR
- " column) "
END-IF
*Subtest 0503f ends
*Subtest 0503g begins.
*If it will not compile, save error message
*and then delete the subtest with TEd "hooks".
*Privilege violation AND syntax error (2 columns in row)
DISPLAY " "
MOVE 0 TO SQLCODE
MOVE "x" TO SQLSTATE
DISPLAY "INSERT INTO HU.UPUNIQ VALUES (555666777);"
* EXEC SQL INSERT INTO HU.UPUNIQ VALUES
* (555666777);
CALL "SUB8" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
DISPLAY "SQLSTATE should be '42000'; its value is ",
SQLSTATE
PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
if (SQLCODE NOT < 0 OR NR-TAB NOT = "42000") then
MOVE 0 TO flag
END-IF
if (SQLCODE NOT = SQLCD4 OR SQLSTATE NOT = SQLST4)
then
DISPLAY "Optional security note:"
DISPLAY "Different message for access violation and "
DISPLAY " access violation with syntax error (wrong #
- " columns) "
END-IF
*Subtest 0503g ends
* EXEC SQL ROLLBACK WORK;
CALL "SUB9" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
if ( flag = 1 ) then
DISPLAY " *** pass *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0503','pass','MCO');
CALL "SUB10" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " dml084.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0503','fail','MCO');
CALL "SUB11" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB12" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
******************** END TEST0503 ********************
******************** BEGIN TEST0504 *******************
MOVE 1 TO flag
DISPLAY " OPTIONAL TEST0504 "
DISPLAY "SQLSTATE = 42000: syntax error or access rule vio.
- " 2"
DISPLAY "Note: VALID implementation-defined subclass will
- " be"
DISPLAY " accepted instead of no-subclass value of 000
- " "
DISPLAY "Reference ANSI SQL-1992,"
DISPLAY " section 6.3 Access Rule #1"
DISPLAY " section 3.3.4.3 Terms denoting rule
- " requirements"
DISPLAY " section 3.3.4.4 Rule evaluation order"
DISPLAY " - - - - - - - - - - - - - - - - - - -"
DISPLAY "Test numbers 0503 and 0504 check for SQLSTATE"
DISPLAY "42000 on syntax errors and access violations."
DISPLAY "SQL-92 permits, but does not require, an"
DISPLAY "implementation to achieve a high level of security"
DISPLAY "by returning the same error for an access"
DISPLAY "violation as for a reference to a non-existent"
DISPLAY "table. This test exercises several different"
DISPLAY "types of syntax errors and access violations. If"
DISPLAY "you are trying for a high security level, please"
DISPLAY "insure that the compilation AND the run time"
DISPLAY "behavior of all these errors are"
DISPLAY "indistinguishable."
DISPLAY " "
DISPLAY "For minimal SQL-92 conformance, each run time"
DISPLAY "error must produce SQLSTATE 42000 or 42 with some"
DISPLAY "implementor-defined subclass. The subclass can"
DISPLAY "be different for each error. Compile time errors"
DISPLAY "are also permissible."
DISPLAY " "
DISPLAY " "
DISPLAY " "
*HU.UPUPUP DOES NOT EXIST - attempt SELECT
MOVE 0 TO SQLCODE
MOVE "x" TO ct1
MOVE "x" TO SQLSTATE
DISPLAY "SELECT COL2 INTO :ct1 FROM HU.UPUPUP WHERE NUMKEY
- " = 1;"
* EXEC SQL SELECT COL2 INTO :ct1 FROM HU.UPUPUP WHERE NUMKEY
* = 1;
CALL "SUB13" USING SQLCODE SQLSTATE ct1
MOVE SQLCODE TO SQL-COD
DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
DISPLAY "SQLSTATE should be '42000'; its value is ",
SQLSTATE
PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
if (SQLCODE NOT < 0 OR NR-TAB NOT = "42000") then
MOVE 0 TO flag
END-IF
if (SQLCODE NOT = SQLCD1 OR SQLSTATE NOT = SQLST1)
then
DISPLAY "Optional security note:"
DISPLAY "Different message for SELECT access violation "
DISPLAY "and SELECT on table which does not exist."
END-IF
*HU.UPUPUP does not exist - attempt UPDATE
DISPLAY " "
MOVE 0 TO SQLCODE
MOVE "x" TO SQLSTATE
DISPLAY "UPDATE HU.UPUPUP SET COL2 = 'xx';"
* EXEC SQL UPDATE HU.UPUPUP SET COL2 = 'xx';
CALL "SUB14" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
DISPLAY "SQLSTATE should be '42000'; its value is ",
SQLSTATE
PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
if (SQLCODE NOT < 0 OR NR-TAB NOT = "42000") then
MOVE 0 TO flag
END-IF
if (SQLCODE NOT = SQLCD2 OR SQLSTATE NOT = SQLST2)
then
DISPLAY "Optional security note:"
DISPLAY "Different message for UPDATE access violation "
DISPLAY "and UPDATE of table which does not exist."
END-IF
*HU.UPUPUP does not exist - attempt DELETE
DISPLAY " "
MOVE 0 TO SQLCODE
MOVE "x" TO SQLSTATE
DISPLAY "DELETE FROM HU.UPUPUP;"
* EXEC SQL DELETE FROM HU.UPUPUP;
CALL "SUB15" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
DISPLAY "SQLSTATE should be '42000'; its value is ",
SQLSTATE
PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
if (SQLCODE NOT < 0 OR NR-TAB NOT = "42000") then
MOVE 0 TO flag
END-IF
if (SQLCODE NOT = SQLCD3 OR SQLSTATE NOT = SQLST3)
then
DISPLAY "Optional security note:"
DISPLAY "Different message for DELETE access violation "
DISPLAY "and DELETE for table which does not exist."
END-IF
*HU.UPUPUP does not exist - attempt insert
DISPLAY " "
MOVE 0 TO SQLCODE
MOVE "x" TO SQLSTATE
DISPLAY "INSERT INTO HU.UPUPUP VALUES (9,'M');"
* EXEC SQL INSERT INTO HU.UPUPUP VALUES (9,'M');
CALL "SUB16" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
DISPLAY "SQLSTATE should be '42000'; its value is ",
SQLSTATE
PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
if (SQLCODE NOT < 0 OR NR-TAB NOT = "42000") then
MOVE 0 TO flag
END-IF
if (SQLCODE NOT = SQLCD4 OR SQLSTATE NOT = SQLST4)
then
DISPLAY "Optional security note:"
DISPLAY "Different message for INSERT access violation "
DISPLAY "and INSERT for table which does not exist."
END-IF
*HU.UPUPUP DOES NOT EXIST - inessential part of middle subquery
COMPUTE tmpcnt = -1
DISPLAY " "
MOVE 0 TO SQLCODE
MOVE "x" TO SQLSTATE
DISPLAY "SELECT COUNT(*) INTO :tmpcnt FROM HU.STAFF"
DISPLAY "WHERE GRADE <"
DISPLAY " (SELECT MAX(HOURS) FROM HU.WORKS)"
DISPLAY "OR GRADE >"
DISPLAY " (SELECT MAX(NUMKEY) FROM HU.UPUPUP)"
DISPLAY "OR GRADE + 100 >"
DISPLAY " (SELECT MIN(HOURS) FROM HU.WORKS);"
* EXEC SQL SELECT COUNT(*) INTO :tmpcnt FROM HU.STAFF
* WHERE GRADE <
* (SELECT MAX(HOURS) FROM HU.WORKS)
* OR GRADE >
* (SELECT MAX(NUMKEY) FROM HU.UPUPUP)
* OR GRADE + 100 >
* (SELECT MIN(HOURS) FROM HU.WORKS);
CALL "SUB17" USING SQLCODE SQLSTATE tmpcnt
MOVE SQLCODE TO SQL-COD
DISPLAY "tmpcnt should not be 5; its value is ", tmpcnt
DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
DISPLAY "SQLSTATE should be '42000'; its value is ",
SQLSTATE
PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
if (tmpcnt = 5 OR SQLCODE NOT < 0 OR NR-TAB NOT =
"42000") then
MOVE 0 TO flag
END-IF
if (SQLCODE NOT = SQLCD5 OR SQLSTATE NOT = SQLST5)
then
DISPLAY "Optional security note:"
DISPLAY "Different message for access violation and "
DISPLAY " access violation with syntax error (wrong #
- " columns) "
END-IF
* EXEC SQL ROLLBACK WORK;
CALL "SUB18" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
if ( flag = 1 ) then
DISPLAY " *** pass *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0504','pass','MCO');
CALL "SUB19" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
else
DISPLAY " dml084.sco *** fail *** "
* EXEC SQL INSERT INTO HU.TESTREPORT
* VALUES('0504','fail','MCO');
CALL "SUB20" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY "==============================================="
* EXEC SQL COMMIT WORK;
CALL "SUB21" USING SQLCODE SQLSTATE
MOVE SQLCODE TO SQL-COD
******************** END TEST0504 ********************
**** 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.30 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.
|
| |
