Quelle dml082.cob Sprache: Cobol

       IDENTIFICATION DIVISION.
       PROGRAM-ID.  DML082.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SOURCE-COMPUTER.  xyz.
       OBJECT-COMPUTER.  xyz.
       DATA DIVISION.
       WORKING-STORAGE SECTION.

      * Standard COBOL (file "DML082.SCO") calling SQL
      * procedures in file "DML082.MCO".
      * STANDARD COBOL (file "DML082.SCO")

      ****************************************************************
      *
      *                 COMMENT SECTION
      *
      * DATE 1992/07/07 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.
      *
      * DML082.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  indic1 PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
       01  huge PIC  X(1).
       01  tmpcnt PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  SMALL1 PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
       01  LONG1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  esch1 PIC  X(1).
       01  esch2 PIC  X(2).
       01  patrn6 PIC  X(6).
       01  patrn7 PIC  X(7).
       01  colval PIC  X(15).
      *  EXEC SQL END DECLARE SECTION END-EXEC
       01  SQLCD1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  ii PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  i33000 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  maxlon PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  loopct 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  testst PIC  X(5).
       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  flag2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  flag3 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

           DISPLAY
              "SQL Test Suite, V6.0, Standard COBOL, dml082.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 TEST0491 *******************
             MOVE 0 TO flag

             DISPLAY " TEST0491 "
             DISPLAY "SQLSTATE = 22022: data exception (indicator
      -    " overflow)"
             DISPLAY "Reference ANSI SQL-1992 section 9.1 Retrieval
      -    " assignment"
             DISPLAY " General Rule #2"
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

      *This test is assumed passed if the database cannot create
      *a CHAR column of size 33000 for table FLATER.TINY.  It is
      *also passed by the program logic if the type of the
      *indicator variable gets changed to long int.

      *42000, the SQLSTATE for syntax error or access rule
      *violation, reflects the fact that a nonexistent table
      *has been queried.  If the test will not compile because
      *TINY does not exist, save the error message and use TEd
      *to delete this test case: it is a pass.

             MOVE 33000 TO i33000
             COMPUTE indic1 = -44
             MOVE 0 TO tmpcnt
             MOVE "z" TO huge

      *  EXEC SQL DELETE FROM FLATER.TINY;
             CALL "SUB2" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
      *  EXEC SQL INSERT INTO FLATER.TINY VALUES
      *       ('Too long for its own good!');
             CALL "SUB3" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
             MOVE 44 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY "SELECT COUNT(*) INTO :tmpcnt FROM FLATER.TINY;"
             DISPLAY "(SQLCD1=SQLCODE, SQLST1=SQLSTATE for this SELECT
      -    " COUNT(*))"
      *  EXEC SQL SELECT COUNT(*) INTO :tmpcnt FROM FLATER.TINY
      * ;
             CALL "SUB4" USING SQLCODE SQLSTATE tmpcnt
             MOVE SQLCODE TO SQL-COD
             MOVE SQLCODE TO SQLCD1
             MOVE SQLSTATE TO SQLST1
             PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             MOVE NR-TAB TO testst

             MOVE 44 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY "SELECT C1 INTO :huge:indic1 FROM FLATER.TINY;"
      *  EXEC SQL SELECT C1 INTO :huge:indic1 FROM FLATER.TINY
      * ;
             CALL "SUB5" USING SQLCODE SQLSTATE huge indic1
             MOVE SQLCODE TO SQL-COD
             PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS

             DISPLAY  " "
             DISPLAY "To pass, you need EITHER:"
             DISPLAY "No such table!"
             DISPLAY " SQLCD1 < 0, SQLST1 = '42000',"
             DISPLAY " SQLCODE < 0, and SQLSTATE = '42000'"
             DISPLAY  " "
             DISPLAY "OR:"
             DISPLAY "Indicator overflow!"
             DISPLAY " SQLCD1 = 0, SQLST1 = '00000', tmpcnt =
      -    " 1"
             DISPLAY " SQLCODE < 0, and SQLSTATE = '22022'"
             DISPLAY  " "
             DISPLAY "OR:"
             DISPLAY "Successful completion!"
             DISPLAY " SQLCD1 = 0, SQLST1 = '00000', tmpcnt =
      -    " 1"
             DISPLAY " SQLCODE >= 0, SQLSTATE = '01004'"
             DISPLAY " indic1 = 33000, and huge = 'T'"
             DISPLAY  " "
             DISPLAY "SQLCD1 is ", SQLCD1 "; SQLST1 is ", SQLST1
             DISPLAY "tmpcnt is ", tmpcnt
             DISPLAY "SQLCODE is ", SQL-COD "; SQLSTATE is ", SQLSTATE
             if (SQLCODE  =  0) then
               DISPLAY "indic1 is ", indic1 "; huge is ", huge " "
             END-IF

      *test for no such table
             MOVE 0 TO flag2
             if (SQLCD1  <  0  AND  testst   =   "42000") then
               MOVE 1 TO flag2
             END-IF
             if (flag2  =  1  AND  SQLCODE  <  0  AND  NR-TAB   =
             "42000") then
               MOVE 1 TO flag
             END-IF

      *test for indicator overflow
             MOVE 0 TO flag2
             if (SQLCD1  =  0  AND  testst   =   "00000"  AND  tmpcnt  =
              1) then
               MOVE 1 TO flag2
             END-IF
             if (flag2  =  1  AND  SQLCODE  <  0  AND  SQLSTATE   =
             "22022") then
               MOVE 1 TO flag
             END-IF

      *test for successful completion
             MOVE 0 TO flag2
             MOVE 0 TO flag3
             if (SQLCD1  =  0  AND  testst   =   "00000"  AND  tmpcnt  =
              1) then
               MOVE 1 TO flag2
             END-IF
             if (flag2  =  1  AND  SQLCODE NOT < 0  AND  NR-TAB   =
             "01004") then
               MOVE 1 TO flag3
             END-IF
             if (flag3  =  1  AND  indic1  =  i33000  AND  huge   =
             "T") then
               MOVE 1 TO flag
             END-IF

      *  EXEC SQL ROLLBACK WORK;
             CALL "SUB6" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0491','pass','MCO');
               CALL "SUB7" USING SQLCODE SQLSTATE
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml082.sco *** fail *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0491','fail','MCO');
               CALL "SUB8" USING SQLCODE SQLSTATE
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
             END-IF

             DISPLAY "==============================================="

      *  EXEC SQL COMMIT WORK;
             CALL "SUB9" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
      ******************** END TEST0491 ********************

      ******************** BEGIN TEST0492 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0492 "
             DISPLAY "SQLSTATE = 22019: data exception (invalid escape
      -    " char)"
             DISPLAY "Reference ANSI SQL-1992 section 8.5
      -    " predicate>"
             DISPLAY " General Rule #3"
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             MOVE "Percent%Xunder_" TO colval
             DISPLAY "UPDATE HU.STAFF SET CITY = ", colval
             DISPLAY " WHERE EMPNUM = 'E1';"
      *  EXEC SQL UPDATE HU.STAFF SET CITY = :colval
      *    WHERE EMPNUM = 'E1';
             CALL "SUB10" USING SQLCODE SQLSTATE colval
             MOVE SQLCODE TO SQL-COD
             DISPLAY  " "

      *Subtest 0492a begins.
      *If it will not compile, save error message
      *and then delete the subtest with TEd "hooks".

      *literal escape character  - 2-byte escape char
             MOVE 44 TO SQLCODE
             MOVE "x" TO SQLSTATE
             MOVE "%XX%X_%" TO patrn7
             DISPLAY "SELECT COUNT(*) FROM HU.STAFF WHERE"
             DISPLAY "CITY LIKE ", patrn7 " ESCAPE 'XX';"
      *  EXEC SQL SELECT COUNT(*) INTO :tmpcnt
      *    FROM HU.STAFF WHERE CITY
      *    LIKE '%XX%X_%' ESCAPE 'XX';
             CALL "SUB11" USING SQLCODE SQLSTATE tmpcnt
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be '22019'; its value is ",
             SQLSTATE
             if (SQLCODE  NOT <  0  OR  SQLSTATE  NOT  =   "22019") then
               MOVE 0 TO flag
             END-IF
      *Subtest 0492a ends

      *literal escape character  - 1-byte escape char
             MOVE 44 TO SQLCODE
             MOVE "x" TO SQLSTATE
             COMPUTE tmpcnt = -1
             DISPLAY  " "
             MOVE "%XX%X_%" TO patrn7
             DISPLAY "SELECT COUNT(*) INTO :tmpcnt FROM HU.STAFF WHERE"
             DISPLAY "CITY LIKE ", patrn7 " ESCAPE 'X';"
      *  EXEC SQL SELECT COUNT(*) INTO :tmpcnt
      *    FROM HU.STAFF WHERE CITY LIKE '%XX%X_%' ESCAPE 'X'
      * ;
             CALL "SUB12" USING SQLCODE SQLSTATE tmpcnt
             MOVE SQLCODE TO SQL-COD
             DISPLAY "tmpcnt should be 1; its value is ", tmpcnt
             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 (tmpcnt  NOT =  1  OR  SQLCODE  NOT =  0  OR  NR-TAB
             NOT  =   "00000") then
               MOVE 0 TO flag
             END-IF

      *Subtest 0492c begins.
      *If it will not compile, save error message
      *and then delete the subtest with TEd "hooks".

      *parameter escape character - 2-byte escape char
             MOVE 44 TO SQLCODE
             MOVE "x" TO SQLSTATE
             MOVE "XX" TO esch2
             DISPLAY  " "
             MOVE "%XX_%" TO patrn7
             DISPLAY "SELECT COUNT(*) INTO :tmpcnt FROM HU.STAFF WHERE"
             DISPLAY "CITY LIKE ", patrn7 " ESCAPE :esch2;"
             DISPLAY "Note that esch2 = 'XX'"
      *  EXEC SQL SELECT COUNT(*) INTO :tmpcnt
      *    FROM HU.STAFF WHERE CITY
      *    LIKE '%XX_%' ESCAPE :esch2;
             CALL "SUB13" USING SQLCODE SQLSTATE tmpcnt esch2
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be '22019'; its value is ",
             SQLSTATE
             if (SQLCODE  NOT <  0  OR  SQLSTATE  NOT  =   "22019") then
               MOVE 0 TO flag
             END-IF
      *Subtest 0492c ends

      *parameter escape character  - 1-byte escape char
             MOVE 44 TO SQLCODE
             MOVE "x" TO SQLSTATE
             MOVE "X" TO esch1
             COMPUTE tmpcnt = -1
             DISPLAY  " "
             MOVE "%XX_%" TO patrn7
             DISPLAY "SELECT COUNT(*) FROM HU.STAFF WHERE"
             DISPLAY "CITY LIKE ", patrn7 " ESCAPE :esch1;"
             DISPLAY "Note that esch1 = 'X'"
      *  EXEC SQL SELECT COUNT(*) INTO :tmpcnt
      *    FROM HU.STAFF WHERE CITY
      *    LIKE '%XX_%' ESCAPE :esch1;
             CALL "SUB14" USING SQLCODE SQLSTATE tmpcnt esch1
             MOVE SQLCODE TO SQL-COD
             DISPLAY "tmpcnt should be 1; its value is ", tmpcnt
             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 (tmpcnt  NOT =  1  OR  SQLCODE  NOT =  0  OR  NR-TAB
             NOT  =   "00000") then
               MOVE 0 TO flag
             END-IF

      *  EXEC SQL ROLLBACK WORK;
             CALL "SUB15" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0492','pass','MCO');
               CALL "SUB16" USING SQLCODE SQLSTATE
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml082.sco *** fail *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0492','fail','MCO');
               CALL "SUB17" USING SQLCODE SQLSTATE
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
             END-IF

             DISPLAY "==============================================="

      *  EXEC SQL COMMIT WORK;
             CALL "SUB18" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
      ******************** END TEST0492 ********************

      ******************** BEGIN TEST0493 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0493 "
             DISPLAY "SQLSTATE = 22025: data exception (invalid escape
      -    " sequence)"
             DISPLAY "Reference ANSI SQL-1992 section 8.5
      -    " predicate>"
             DISPLAY " General Rule #3"
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             MOVE "Per%X&und_" TO colval
      *  EXEC SQL DELETE FROM CPBASE;
             CALL "SUB19" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
             DISPLAY "INSERT INTO CPBASE VALUES (82,'Per%X&und_')"
      *  EXEC SQL INSERT INTO CPBASE VALUES (82,'Per%X&und_')
      * ;
             CALL "SUB20" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

      *Subtest 0493a begins.
      *If it will not compile, save error message
      *and then delete the subtest with TEd "hooks".

      *SELECT...LIKE, literal escape char, literal pattern -
      *pattern ends with escape char
             MOVE 44 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY  " "
             MOVE "P%X%%X" TO patrn7
             DISPLAY "SELECT COUNT(*) FROM CPBASE WHERE"
             DISPLAY "JUNK1 LIKE ", patrn7 " ESCAPE 'X';"
      *  EXEC SQL SELECT COUNT(*) INTO :tmpcnt
      *    FROM CPBASE WHERE JUNK1
      *    LIKE 'P%X%%X' ESCAPE 'X';
             CALL "SUB21" USING SQLCODE SQLSTATE tmpcnt
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be '22025'; its value is ",
             SQLSTATE
             if (SQLCODE  NOT <  0  OR  SQLSTATE  NOT  =   "22025") then
               MOVE 0 TO flag
             END-IF
      *Subtest 0493a ends

      *variation that should work - remove last X in pattern
             COMPUTE tmpcnt = -1
             MOVE 44 TO SQLCODE
             MOVE "x" TO SQLSTATE
             MOVE "P%X%%" TO patrn7
             DISPLAY  " "
             DISPLAY "SELECT COUNT(*) INTO :tmpcnt FROM CPBASE"
             DISPLAY " WHERE JUNK1 LIKE ", patrn7 " ESCAPE 'X';"
      *  EXEC SQL SELECT COUNT(*) INTO :tmpcnt
      *    FROM CPBASE WHERE JUNK1
      *    LIKE 'P%X%%' ESCAPE 'X';
             CALL "SUB22" USING SQLCODE SQLSTATE tmpcnt
             MOVE SQLCODE TO SQL-COD
             DISPLAY "After removing the last X in the pattern:"
             DISPLAY "tmpcnt should be 1; its value is ", tmpcnt
             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 (tmpcnt  NOT =  1  OR  SQLCODE  NOT =  0  OR  NR-TAB
             NOT  =   "00000") then
               MOVE 0 TO flag
             END-IF

      *Subtest 0493c begins.
      *If it will not compile, save error message
      *and then delete the subtest with TEd "hooks".

      *INSERT...LIKE, literal escape char, parameter pattern -
      *escape char in pattern not followed by
      *percent, underscore, escape char
             MOVE 44 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY  " "
             MOVE "%X%%Xd_" TO patrn7
             DISPLAY "INSERT INTO HU.STAFF"
             DISPLAY "SELECT 'E12','ff',KC,'gg' FROM CPBASE"
             DISPLAY "WHERE JUNK1 LIKE :patrn7 ESCAPE 'X';"
      *  EXEC SQL INSERT INTO HU.STAFF
      *    SELECT 'E12','ff',KC,'gg' FROM CPBASE
      *    WHERE JUNK1 LIKE :patrn7 ESCAPE 'X';
             CALL "SUB23" USING SQLCODE SQLSTATE patrn7
             MOVE SQLCODE TO SQL-COD
             DISPLAY "Note that patrn7 = ", patrn7
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be '22025'; its value is ",
             SQLSTATE
             if (SQLCODE  NOT <  0  OR  SQLSTATE  NOT  =   "22025") then
               MOVE 0 TO flag
             END-IF
      *Subtest 0493c ends

      *variation that should work - remove the "d" in pattern
             MOVE "%X%%X_" TO patrn6
             MOVE 44 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY  " "
             DISPLAY "INSERT INTO HU.STAFF SELECT 'E13','ff',KC,'gg'"
             DISPLAY "FROM CPBASE WHERE JUNK1 LIKE :patrn6 ESCAPE 'X';"
      *  EXEC SQL INSERT INTO HU.STAFF
      *    SELECT 'E13','ff',KC,'gg' FROM CPBASE
      *    WHERE JUNK1 LIKE :patrn6 ESCAPE 'X';
             CALL "SUB24" USING SQLCODE SQLSTATE patrn6
             MOVE SQLCODE TO SQL-COD
             DISPLAY "After removing the 'd' in the pattern:"
             DISPLAY "Note that patrn6 = ", patrn6
             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  NR-TAB  NOT  =   "00000") then
               MOVE 0 TO flag
             END-IF

      *Subtest 0493e begins.
      *If it will not compile, save error message
      *and then delete the subtest with TEd "hooks".

      *UPDATE...LIKE, parameter escape char, literal pattern -
      *escape char in pattern not followed by
      *percent, underscore, escape char
             MOVE 44 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY  " "
             MOVE "?" TO esch1
             MOVE "%?X%" TO patrn7
             DISPLAY "UPDATE CPBASE SET KC = -1 "
             DISPLAY "WHERE JUNK1 LIKE ", patrn7 " ESCAPE :esch1;"
      *  EXEC SQL UPDATE CPBASE SET KC = -1
      *    WHERE JUNK1 LIKE '%?X%' ESCAPE :esch1;
             CALL "SUB25" USING SQLCODE SQLSTATE esch1
             MOVE SQLCODE TO SQL-COD
             DISPLAY "Note that esch1 = ", esch1
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be '22025'; its value is ",
             SQLSTATE
             if (SQLCODE  NOT <  0  OR  SQLSTATE  NOT  =   "22025") then
               MOVE 0 TO flag
             END-IF
      *Subtest 0493e ends

      *variation that should work - add a % after escape char in patte
             MOVE 44 TO SQLCODE
             MOVE "x" TO SQLSTATE
             MOVE "?" TO esch1
             MOVE "%?%X%" TO patrn7
             DISPLAY  " "
             DISPLAY "UPDATE CPBASE SET KC = -1"
             DISPLAY "WHERE JUNK1 LIKE ", patrn7 " ESCAPE :esch1;"
      *  EXEC SQL UPDATE CPBASE SET KC = -1
      *    WHERE JUNK1 LIKE '%?%X%' ESCAPE :esch1;
             CALL "SUB26" USING SQLCODE SQLSTATE esch1
             MOVE SQLCODE TO SQL-COD
             DISPLAY "After adding a percent in the middle of the
      -    " pattern:"
             DISPLAY "Note that esch1 = ", esch1
             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  NR-TAB  NOT  =   "00000") then
               MOVE 0 TO flag
             END-IF

      *Subtest 0493g begins.
      *If it will not compile, save error message
      *and then delete the subtest with TEd "hooks".

      *DELETE... LIKE, parameter escape char, parameter pattern -
      *escape char in pattern not followed by
      *percent, underscore, escape char
             MOVE 44 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY  " "
             MOVE "&" TO esch1
             MOVE "_e%&u%" TO patrn6
             DISPLAY "DELETE FROM CPBASE"
             DISPLAY "WHERE JUNK1 LIKE :patrn6 ESCAPE :esch1;"
      *  EXEC SQL DELETE FROM CPBASE
      *    WHERE JUNK1 LIKE :patrn6 ESCAPE :esch1;
             CALL "SUB27" USING SQLCODE SQLSTATE patrn6 esch1
             MOVE SQLCODE TO SQL-COD
             DISPLAY "Note that patrn6 = ", patrn6 " and escape char =",
                esch1
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be '22025'; its value is ",
             SQLSTATE
             if (SQLCODE  NOT <  0  OR  SQLSTATE  NOT  =   "22025") then
               MOVE 0 TO flag
             END-IF
      *Subtest 0493g ends

      *variation that should work - add an & in pattern
             MOVE 44 TO SQLCODE
             MOVE "x" TO SQLSTATE
             MOVE "&" TO esch1
             MOVE "_e%&&u%" TO patrn7
             DISPLAY  " "
             DISPLAY "DELETE FROM CPBASE"
             DISPLAY "WHERE JUNK1 LIKE :patrn7 ESCAPE :esch1;"
      *  EXEC SQL DELETE FROM CPBASE
      *    WHERE JUNK1 LIKE :patrn7 ESCAPE :esch1;
             CALL "SUB28" USING SQLCODE SQLSTATE patrn7 esch1
             MOVE SQLCODE TO SQL-COD
             DISPLAY "After adding an ampersand in the middle of the
      -    " pattern:"
             DISPLAY "Note that patrn7 = ", patrn7 " and escape char =",
                 esch1
             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  NR-TAB  NOT  =   "00000") then
               MOVE 0 TO flag
             END-IF

      *  EXEC SQL ROLLBACK WORK;
             CALL "SUB29" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0493','pass','MCO');
               CALL "SUB30" USING SQLCODE SQLSTATE
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml082.sco *** fail *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0493','fail','MCO');
               CALL "SUB31" USING SQLCODE SQLSTATE
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
             END-IF

             DISPLAY "==============================================="

      *  EXEC SQL COMMIT WORK;
             CALL "SUB32" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
      ******************** END TEST0493 ********************

      ******************** BEGIN TEST0494 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0494 "
             DISPLAY "SQLSTATE = 22003: data exception "
             DISPLAY "(numeric value out of range)"
             DISPLAY "Reference ANSI SQL-1992 section 9.1 GR 3k "
             DISPLAY " and section 9.2 GR 3k"
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

      *Subtest 0494a begins.
      *If it will not compile, save error message
      *and then delete the subtest with TEd "hooks".

      *insert larger and larger long parameter
             DISPLAY  " "
      *  EXEC SQL DELETE FROM HU.HH;
             CALL "SUB33" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
             MOVE 44 TO SQLCODE
             MOVE "x" TO SQLSTATE
             MOVE 0 TO maxlon
             MOVE 10 TO LONG1
             MOVE 1 TO ii
             PERFORM P50 UNTIL ii > 50

           .
        P173.
             DISPLAY "INSERT INTO HU.HH VALUES (:LONG1) done ", loopct "
      -    " times"
             DISPLAY "For values 10, 100, 1000, 10000, etc."
             DISPLAY "The maximum value inserted was ", maxlon
             if (SQLCODE  NOT <  0) then
               GO TO P174
             END-IF
             DISPLAY " before a negative SQLCODE was returned"
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be '22003'; its value is ",
             SQLSTATE
             if (SQLSTATE  NOT  =   "22003") then
               MOVE 0 TO flag
             END-IF
           .
        P174.
             if (SQLCODE  NOT <  0) then
               DISPLAY "Exception not encountered. Pass by default."
             END-IF
      *  EXEC SQL ROLLBACK WORK;
             CALL "SUB34" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
      *Subtest 0494a ends

      *Subtest 0494b begins.
      *If it will not compile, save error message
      *and then delete the subtest with TEd "hooks".

      *enlarge value in table FF to the max
             DISPLAY  " "
      *  EXEC SQL DELETE FROM HU.FF;
             CALL "SUB35" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
      *  EXEC SQL INSERT INTO HU.FF VALUES (99999);
             CALL "SUB36" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
             DISPLAY "Starting at value 99999, UPDATE to multiply by 10"
             MOVE 1 TO ii
             PERFORM P49 UNTIL ii > 50
           .
        P175.
             DISPLAY "Column INTTEST was multiplied by 10 ", loopct "
      -    " times"
      *We are now ready to select it back.

      *select back that large value into a short
             DISPLAY  " "
             MOVE 44 TO SQLCODE
             MOVE "x" TO SQLSTATE
             COMPUTE SMALL1 = -1
             DISPLAY "SELECT INTTEST INTO :SMALL1 FROM HU.FF;"
      *  EXEC SQL SELECT INTTEST INTO :SMALL1 FROM HU.FF;
             CALL "SUB37" USING SQLCODE SQLSTATE SMALL1
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  =  0) then
             DISPLAY
             "The large value from HU.FF was selected as SMALLINT."
             END-IF
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be '22003'; its value is ",
             SQLSTATE
             if (SQLCODE  NOT <  0  OR  SQLSTATE  NOT  =   "22003") then
               MOVE 0 TO flag
             END-IF
      *  EXEC SQL ROLLBACK WORK;
             CALL "SUB38" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
      *Subtest 0494b ends

      *  EXEC SQL ROLLBACK WORK;
             CALL "SUB39" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0494','pass','MCO');
               CALL "SUB40" USING SQLCODE SQLSTATE
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml082.sco *** fail *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0494','fail','MCO');
               CALL "SUB41" USING SQLCODE SQLSTATE
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
             END-IF

           .
        P100.
             DISPLAY "==============================================="

      *  EXEC SQL COMMIT WORK;
             CALL "SUB42" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
      ******************** END TEST0494 ********************

      ******************** BEGIN TEST0505 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0505 "
             DISPLAY "SQLSTATE = 44000: with check option violation"
             DISPLAY "Note: VALID implementation-defined subclass will
      -    " be"
             DISPLAY " accepted instead of no-subclass value of 000
      -    " "
             DISPLAY "Reference ANSI SQL-1992,"
             DISPLAY " section 11.19 General Rule
      -    " #11a"
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             MOVE 44 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY "INSERT INTO FLATER.WCOV VALUES (0);"
             DISPLAY " the CHECK clause is CHECK FLATER.WCOV.C1 > 0 "
      *  EXEC SQL INSERT INTO FLATER.WCOV VALUES (0);
             CALL "SUB43" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be '44000'; its value is ",
             SQLSTATE

             PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE  NOT <  0  OR  NR-TAB  NOT  =   "44000") then
               MOVE 0 TO flag
             END-IF

             DISPLAY  " "
             MOVE 44 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY "INSERT INTO FLATER.WCOV VALUES (75);"
      *  EXEC SQL INSERT INTO FLATER.WCOV VALUES (75);
             CALL "SUB44" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

             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  NR-TAB  NOT  =   "00000") then
               MOVE 0 TO flag
             END-IF

             DISPLAY  " "
             MOVE 44 TO SQLCODE
             MOVE "x" TO SQLSTATE
             DISPLAY "UPDATE FLATER.WCOV SET C1 = -C1 WHERE C1 = 75;"
      *  EXEC SQL UPDATE FLATER.WCOV SET C1 = -C1 WHERE C1 = 75
      * ;
             CALL "SUB45" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be '44000'; its value is ",
             SQLSTATE

             PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE  NOT <  0  OR  NR-TAB  NOT  =   "44000") then
               MOVE 0 TO flag
             END-IF

      *  EXEC SQL ROLLBACK WORK;
             CALL "SUB46" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0505','pass','MCO');
               CALL "SUB47" USING SQLCODE SQLSTATE
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml082.sco *** fail *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0505','fail','MCO');
               CALL "SUB48" USING SQLCODE SQLSTATE
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
             END-IF

             DISPLAY "==============================================="

      *  EXEC SQL COMMIT WORK;
             CALL "SUB49" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
      ******************** END TEST0505 ********************

      **** 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.

        P50.
      *    EXEC SQL INSERT INTO HU.HH VALUES (:LONG1);
               CALL "SUB50" USING SQLCODE SQLSTATE LONG1
               MOVE SQLCODE TO SQL-COD
               if (SQLCODE  <  0) then
                 GO TO P173
               END-IF
               MOVE ii TO loopct
               if (LONG1  >  maxlon) then
                 MOVE LONG1 TO maxlon
               END-IF
               COMPUTE LONG1 = LONG1 * 10
             ADD 1 TO ii
           .

        P49.
      *    EXEC SQL UPDATE HU.FF SET INTTEST = 10 * INTTEST;
               CALL "SUB51" USING SQLCODE SQLSTATE
               MOVE SQLCODE TO SQL-COD
               if (SQLCODE  <  0) then
                 GO TO P175
               END-IF
               MOVE ii TO loopct
             ADD 1 TO ii
           .

quality100%

¤ Dauer der Verarbeitung: 0.23 Sekunden (vorverarbeitet) ¤

Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

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.