Quelle dml152.cob Sprache: Cobol

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

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

      ****************************************************************
      *
      *                 COMMENT SECTION
      *
      * DATE 1994/7/11 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.
      *
      * DML152.SCO
      * WRITTEN BY:  David W. Flater
      * TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE
      *
      * This routine tests FIPS feature 12 (GET DIAGNOSTICS).
      *
      * REFERENCES
      *   FIPS PUB 127-2 14.1 Transitional SQL
      *   ANSI SQL-1992
      *
      ****************************************************************

      * 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  int1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  int2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  num PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  cmd PIC  X(15).
       01  st PIC  X(5).
       01  co PIC  X(11).
       01  sco PIC  X(11).
       01  nl1 PIC  X(1).
       01  nl2 PIC  X(1).
       01  nl3 PIC  X(1).
       01  nl4 PIC  X(1).
       01  nl5 PIC  X(1).
       01  mtxt PIC  X(50).
       01  mlen PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  omlen PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  olds PIC  X(5).
       01  snam PIC  X(6).
       01  tnam PIC  X(5).
       01  cnam PIC  X(4).
      *  EXEC SQL END DECLARE SECTION END-EXEC
       01  odsflg 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  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 "FLATER " 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
      *  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, dml152.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 TEST0667 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0667 "
             DISPLAY " Diagnostics: access violations"
             DISPLAY "References:"
             DISPLAY " F# 12 -- Get diagnostics"
             DISPLAY " 18.1 GR.3.g -- "
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

      *Future work:  figure out how to test GR.3.j

             COMPUTE SQLCODE = -1
             MOVE "xxxxx" TO SQLSTATE

      *Subtest 1:  No privileges

             DISPLAY "SELECT COUNT(*) INTO :int1 FROM HU.STAFF2;"
      *  EXEC SQL SELECT COUNT(*) INTO :int1 FROM HU.STAFF2;
             CALL "SUB3" USING SQLCODE SQLSTATE int1
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             if (SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF
             MOVE SQLSTATE TO olds
             DISPLAY "SQLSTATE should be 42000; its value is ", SQLSTATE
           PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (NORMSQ  NOT  =   "42000") then
               MOVE 0 TO flag
             END-IF
             MOVE 0 TO odsflg
             if (NORMSQ   =   "42000"  AND  NORMSQ  NOT  =   SQLSTATE)
             then
               DISPLAY "Valid implementation-defined SQLSTATE accepted."
               MOVE 1 TO odsflg
             END-IF
             DISPLAY  " "

      *18.1 GR.3.g.i

             COMPUTE int1 = -1
             MOVE "xxxxx" TO st
             MOVE "xxxxxxxxxxx" TO co
             MOVE "xxxxxxxxxxx" TO sco
             MOVE "x" TO nl1
             MOVE "x" TO nl4
             MOVE "x" TO nl5
             MOVE "xxxxxx" TO snam
             MOVE "xxxxx" TO tnam
             MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
             TO mtxt
             COMPUTE mlen = -1
             COMPUTE omlen = -1
             DISPLAY "GET DIAGNOSTICS EXCEPTION 1"
             DISPLAY " :int1 = CONDITION_NUMBER, :st =
      -    " RETURNED_SQLSTATE,"
             DISPLAY " :co = CLASS_ORIGIN, :sco = SUBCLASS_ORIGIN,"
             DISPLAY " :nl1 = CONSTRAINT_SCHEMA, :snam = SCHEMA_NAME,"
             DISPLAY " :tnam = TABLE_NAME, :nl4 = COLUMN_NAME,"
             DISPLAY " :nl5 = CURSOR_NAME, :mtxt = MESSAGE_TEXT,"
             DISPLAY " :mlen = MESSAGE_LENGTH, :omlen =
      -    " MESSAGE_OCTET_LENGTH;"
      *  EXEC SQL GET DIAGNOSTICS EXCEPTION 1
      *    :int1 = CONDITION_NUMBER, :st = RETURNED_SQLSTATE,
      *    :co = CLASS_ORIGIN, :sco = SUBCLASS_ORIGIN,
      *    :nl1 = CONSTRAINT_SCHEMA, :snam = SCHEMA_NAME,
      *    :tnam = TABLE_NAME, :nl4 = COLUMN_NAME,
      *    :nl5 = CURSOR_NAME, :mtxt = MESSAGE_TEXT,
      *    :mlen = MESSAGE_LENGTH, :omlen = MESSAGE_OCTET_LENGTH
      * ;
             CALL "SUB4" USING SQLCODE SQLSTATE
                  int1 st co sco nl1 snam tnam nl4
             nl5 mtxt mlen omlen
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be >= 0; its value is ", SQL-COD
             if (SQLCODE  <  0) then
               MOVE 0 TO flag
             END-IF
             DISPLAY "SQLSTATE should be 01004; its value is ", SQLSTATE
           PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (NORMSQ  NOT  =   "01004") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "int1 should be 1; its value is ", int1
             if (int1  NOT =  1) then
               MOVE 0 TO flag
             END-IF
             DISPLAY "snam should be 'HU '; its value is '", snam "'"
             if (snam  NOT  =   "HU ") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "tnam should be 'STAFF' (STAFF2 won't fit); its
      -    " value is '", tnam "'"
             if (tnam  NOT  =   "STAFF") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "st should be ", olds "; its value is ", st
             if (st  NOT  =   olds) then
               MOVE 0 TO flag
             END-IF
             DISPLAY "co should be 'ISO 9075 '; its value is ", co
             if (co  NOT  =   "ISO 9075 ") then
               MOVE 0 TO flag
             END-IF

             if (odsflg  =  1) then
               GO TO P191
             END-IF
             DISPLAY "sco should be 'ISO 9075 '; its value is ", sco
             if (sco  NOT  =   "ISO 9075 ") then
               MOVE 0 TO flag
             END-IF
             GO TO P190
           .
        P191.
             DISPLAY "sco should NOT be 'ISO 9075 '; its value is ",
             sco
             if (sco   =   "ISO 9075 ") then
               MOVE 0 TO flag
             END-IF

           .
        P190.
             DISPLAY "nl1 should be ' '; its value is '", nl1 "'"
             if (nl1  NOT  =   " ") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "nl4 should be ' '; its value is '", nl4 "'"
             if (nl4  NOT  =   " ") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "nl5 should be ' '; its value is '", nl5 "'"
             if (nl5  NOT  =   " ") then
               MOVE 0 TO flag
             END-IF

             DISPLAY "mtxt should be meaningful or blank; its value is
      -    " '", mtxt "'"
             if (mtxt   =
             "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "mlen should be >= 0; its value is ", mlen
             DISPLAY "omlen should be >= 0; its value is ", omlen
             if (mlen  <  0  OR  omlen  <  0) then
               MOVE 0 TO flag
             END-IF

      *Subtest 2:  Read-only

             DISPLAY "DELETE FROM HU.PROJ;"
      *  EXEC SQL DELETE FROM HU.PROJ;
             CALL "SUB5" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             if (SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF
             MOVE SQLSTATE TO olds
             DISPLAY "SQLSTATE should be 42000; its value is ", SQLSTATE
           PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (NORMSQ  NOT  =   "42000") then
               MOVE 0 TO flag
             END-IF
             MOVE 0 TO odsflg
             if (NORMSQ   =   "42000"  AND  NORMSQ  NOT  =   SQLSTATE)
             then
               DISPLAY "Valid implementation-defined SQLSTATE accepted."
               MOVE 1 TO odsflg
             END-IF
             DISPLAY  " "

             COMPUTE int1 = -1
             MOVE "xxxxx" TO st
             MOVE "xxxxxxxxxxx" TO co
             MOVE "xxxxxxxxxxx" TO sco
             MOVE "x" TO nl1
             MOVE "xxxxxx" TO snam
             MOVE "xxxxx" TO tnam
             MOVE "x" TO nl4
             MOVE "x" TO nl5
             MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
             TO mtxt
             COMPUTE mlen = -1
             COMPUTE omlen = -1
             DISPLAY "GET DIAGNOSTICS EXCEPTION 1"
             DISPLAY " :int1 = CONDITION_NUMBER, :st =
      -    " RETURNED_SQLSTATE,"
             DISPLAY " :co = CLASS_ORIGIN, :sco = SUBCLASS_ORIGIN,"
             DISPLAY " :nl1 = CONSTRAINT_SCHEMA, :snam = SCHEMA_NAME,"
             DISPLAY " :tnam = TABLE_NAME, :nl4 = COLUMN_NAME,"
             DISPLAY " :nl5 = CURSOR_NAME, :mtxt = MESSAGE_TEXT,"
             DISPLAY " :mlen = MESSAGE_LENGTH, :omlen =
      -    " MESSAGE_OCTET_LENGTH;"
      *  EXEC SQL GET DIAGNOSTICS EXCEPTION 1
      *    :int1 = CONDITION_NUMBER, :st = RETURNED_SQLSTATE,
      *    :co = CLASS_ORIGIN, :sco = SUBCLASS_ORIGIN,
      *    :nl1 = CONSTRAINT_SCHEMA, :snam = SCHEMA_NAME,
      *    :tnam = TABLE_NAME, :nl4 = COLUMN_NAME,
      *    :nl5 = CURSOR_NAME, :mtxt = MESSAGE_TEXT,
      *    :mlen = MESSAGE_LENGTH, :omlen = MESSAGE_OCTET_LENGTH
      * ;
             CALL "SUB6" USING SQLCODE SQLSTATE
                  int1 st co sco nl1 snam tnam nl4
             nl5 mtxt mlen omlen
             MOVE SQLCODE TO SQL-COD
             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 01004; its value is ",
             SQLSTATE
           PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (NORMSQ  NOT  =   "00000"  AND  NORMSQ  NOT  =
             "01004") then
               MOVE 0 TO flag
             END-IF
             if (NORMSQ   =   "00000"  AND  NORMSQ  NOT  =   SQLSTATE)
             then
               DISPLAY "Valid implementation-defined SQLSTATE accepted."
             END-IF
             DISPLAY "int1 should be 1; its value is ", int1
             if (int1  NOT =  1) then
               MOVE 0 TO flag
             END-IF
             DISPLAY "st should be ", olds "; its value is ", st
             if (st  NOT  =   olds) then
               MOVE 0 TO flag
             END-IF
             DISPLAY "co should be 'ISO 9075 '; its value is ", co
             if (co  NOT  =   "ISO 9075 ") then
               MOVE 0 TO flag
             END-IF

             if (odsflg  =  1) then
               GO TO P189
             END-IF
             DISPLAY "sco should be 'ISO 9075 '; its value is ", sco
             if (sco  NOT  =   "ISO 9075 ") then
               MOVE 0 TO flag
             END-IF
             GO TO P188
           .
        P189.
             DISPLAY "sco should NOT be 'ISO 9075 '; its value is ",
             sco
             if (sco   =   "ISO 9075 ") then
               MOVE 0 TO flag
             END-IF

           .
        P188.
             DISPLAY "nl1 should be ' '; its value is '", nl1 "'"
             if (nl1  NOT  =   " ") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "snam should be 'HU '; its value is '", snam "'"
             if (snam  NOT  =   "HU ") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "tnam should be 'PROJ '; its value is '", tnam "'"
             if (tnam  NOT  =   "PROJ ") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "nl4 should be ' '; its value is '", nl4 "'"
             if (nl4  NOT  =   " ") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "nl5 should be ' '; its value is '", nl5 "'"
             if (nl5  NOT  =   " ") then
               MOVE 0 TO flag
             END-IF

             DISPLAY "mtxt should be meaningful or blank; its value is
      -    " '", mtxt "'"
             if (mtxt   =
             "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "mlen should be >= 0; its value is ", mlen
             DISPLAY "omlen should be >= 0; its value is ", omlen
             if (mlen  <  0  OR  omlen  <  0) then
               MOVE 0 TO flag
             END-IF

      *Subtest 3:  Inaccessible column

             DISPLAY "UPDATE HU.VTABLE SET COL2 = 5;"
      *  EXEC SQL UPDATE HU.VTABLE SET COL2 = 5;
             CALL "SUB7" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             if (SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF
             MOVE SQLSTATE TO olds
             DISPLAY "SQLSTATE should be 42000; its value is ", SQLSTATE
           PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (NORMSQ  NOT  =   "42000") then
               MOVE 0 TO flag
             END-IF
             MOVE 0 TO odsflg
             if (NORMSQ   =   "42000"  AND  NORMSQ  NOT  =   SQLSTATE)
             then
               DISPLAY "Valid implementation-defined SQLSTATE accepted."
               MOVE 1 TO odsflg
             END-IF
             DISPLAY  " "

             COMPUTE int1 = -1
             MOVE "xxxxx" TO st
             MOVE "xxxxxxxxxxx" TO co
             MOVE "xxxxxxxxxxx" TO sco
             MOVE "x" TO nl1
             MOVE "xxxxxx" TO snam
             MOVE "xxxxx" TO tnam
             MOVE "xxxx" TO cnam
             MOVE "x" TO nl5
             MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
             TO mtxt
             COMPUTE mlen = -1
             COMPUTE omlen = -1
             DISPLAY "GET DIAGNOSTICS EXCEPTION 1"
             DISPLAY " :int1 = CONDITION_NUMBER, :st =
      -    " RETURNED_SQLSTATE,"
             DISPLAY " :co = CLASS_ORIGIN, :sco = SUBCLASS_ORIGIN,"
             DISPLAY " :nl1 = CONSTRAINT_SCHEMA, :snam = SCHEMA_NAME,"
             DISPLAY " :tnam = TABLE_NAME, :cnam = COLUMN_NAME,"
             DISPLAY " :nl5 = CURSOR_NAME, :mtxt = MESSAGE_TEXT,"
             DISPLAY " :mlen = MESSAGE_LENGTH, :omlen =
      -    " MESSAGE_OCTET_LENGTH;"
      *  EXEC SQL GET DIAGNOSTICS EXCEPTION 1
      *    :int1 = CONDITION_NUMBER, :st = RETURNED_SQLSTATE,
      *    :co = CLASS_ORIGIN, :sco = SUBCLASS_ORIGIN,
      *    :nl1 = CONSTRAINT_SCHEMA, :snam = SCHEMA_NAME,
      *    :tnam = TABLE_NAME, :cnam = COLUMN_NAME,
      *    :nl5 = CURSOR_NAME, :mtxt = MESSAGE_TEXT,
      *    :mlen = MESSAGE_LENGTH, :omlen = MESSAGE_OCTET_LENGTH
      * ;
             CALL "SUB8" USING SQLCODE SQLSTATE
                  int1 st co sco nl1 snam tnam cnam
             nl5 mtxt mlen omlen
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be >= 0; its value is ", SQL-COD
             if (SQLCODE  <  0) then
               MOVE 0 TO flag
             END-IF
             DISPLAY "(tnam is one character too short)"
             DISPLAY "SQLSTATE should be 01004; its value is ", SQLSTATE
             if (NORMSQ  NOT  =   "01004") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "int1 should be 1; its value is ", int1
             if (int1  NOT =  1) then
               MOVE 0 TO flag
             END-IF
             DISPLAY "st should be ", olds "; its value is ", st
             if (st  NOT  =   olds) then
               MOVE 0 TO flag
             END-IF
             DISPLAY "co should be 'ISO 9075 '; its value is ", co
             if (co  NOT  =   "ISO 9075 ") then
               MOVE 0 TO flag
             END-IF

             if (odsflg  =  1) then
               GO TO P187
             END-IF
             DISPLAY "sco should be 'ISO 9075 '; its value is ", sco
             if (sco  NOT  =   "ISO 9075 ") then
               MOVE 0 TO flag
             END-IF
             GO TO P186
           .
        P187.
             DISPLAY "sco should NOT be 'ISO 9075 '; its value is ",
             sco
             if (sco   =   "ISO 9075 ") then
               MOVE 0 TO flag
             END-IF

           .
        P186.
             DISPLAY "nl1 should be ' '; its value is '", nl1 "'"
             if (nl1  NOT  =   " ") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "snam should be 'HU '; its value is '", snam "'"
             if (snam  NOT  =   "HU ") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "tnam should be 'VTABL'; its value is '", tnam "'"
             if (tnam  NOT  =   "VTABL") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "cnam should be 'COL2'; its value is '", cnam "'"
             if (cnam  NOT  =   "COL2") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "nl5 should be ' '; its value is '", nl5 "'"
             if (nl5  NOT  =   " ") then
               MOVE 0 TO flag
             END-IF

             DISPLAY "mtxt should be meaningful or blank; its value is
      -    " '", mtxt "'"
             if (mtxt   =
             "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "mlen should be >= 0; its value is ", mlen
             DISPLAY "omlen should be >= 0; its value is ", omlen
             if (mlen  <  0  OR  omlen  <  0) then
               MOVE 0 TO flag
             END-IF

      *Subtest 4:  Partially accessible column
      *The following GRANT was added to SCHEMA1 for this subtest:
      * GRANT UPDATE (COL1) ON VTABLE TO FLATER
      *Can't do a searched update without SELECT privilege

             DISPLAY "UPDATE HU.VTABLE SET COL1 = 5"
             DISPLAY " WHERE COL1 = 0;"
      *  EXEC SQL UPDATE HU.VTABLE SET COL1 = 5
      *    WHERE COL1 = 0;
             CALL "SUB9" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             if (SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF
             MOVE SQLSTATE TO olds
             DISPLAY "SQLSTATE should be 42000; its value is ", SQLSTATE
           PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (NORMSQ  NOT  =   "42000") then
               MOVE 0 TO flag
             END-IF
             MOVE 0 TO odsflg
             if (NORMSQ   =   "42000"  AND  NORMSQ  NOT  =   SQLSTATE)
             then
               DISPLAY "Valid implementation-defined SQLSTATE accepted."
               MOVE 1 TO odsflg
             END-IF
             DISPLAY  " "

             COMPUTE int1 = -1
             MOVE "xxxxx" TO st
             MOVE "xxxxxxxxxxx" TO co
             MOVE "xxxxxxxxxxx" TO sco
             MOVE "x" TO nl1
             MOVE "xxxxxx" TO snam
             MOVE "xxxxx" TO tnam
             MOVE "xxxx" TO cnam
             MOVE "x" TO nl5
             MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
             TO mtxt
             COMPUTE mlen = -1
             COMPUTE omlen = -1
             DISPLAY "GET DIAGNOSTICS EXCEPTION 1"
             DISPLAY " :int1 = CONDITION_NUMBER, :st =
      -    " RETURNED_SQLSTATE,"
             DISPLAY " :co = CLASS_ORIGIN, :sco = SUBCLASS_ORIGIN,"
             DISPLAY " :nl1 = CONSTRAINT_SCHEMA, :snam = SCHEMA_NAME,"
             DISPLAY " :tnam = TABLE_NAME, :cnam = COLUMN_NAME,"
             DISPLAY " :nl5 = CURSOR_NAME, :mtxt = MESSAGE_TEXT,"
             DISPLAY " :mlen = MESSAGE_LENGTH, :omlen =
      -    " MESSAGE_OCTET_LENGTH;"
      *  EXEC SQL GET DIAGNOSTICS EXCEPTION 1
      *    :int1 = CONDITION_NUMBER, :st = RETURNED_SQLSTATE,
      *    :co = CLASS_ORIGIN, :sco = SUBCLASS_ORIGIN,
      *    :nl1 = CONSTRAINT_SCHEMA, :snam = SCHEMA_NAME,
      *    :tnam = TABLE_NAME, :cnam = COLUMN_NAME,
      *    :nl5 = CURSOR_NAME, :mtxt = MESSAGE_TEXT,
      *    :mlen = MESSAGE_LENGTH, :omlen = MESSAGE_OCTET_LENGTH
      * ;
             CALL "SUB10" USING SQLCODE SQLSTATE
                  int1 st co sco nl1 snam tnam
             cnam nl5 mtxt mlen omlen
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be >= 0; its value is ", SQL-COD
             if (SQLCODE  <  0) then
               MOVE 0 TO flag
             END-IF
             DISPLAY "(tnam is one character too short)"
             DISPLAY "SQLSTATE should be 01004; its value is ", SQLSTATE
             if (NORMSQ  NOT  =   "01004") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "int1 should be 1; its value is ", int1
             if (int1  NOT =  1) then
               MOVE 0 TO flag
             END-IF
             DISPLAY "st should be ", olds "; its value is ", st
             if (st  NOT  =   olds) then
               MOVE 0 TO flag
             END-IF
             DISPLAY "co should be 'ISO 9075 '; its value is ", co
             if (co  NOT  =   "ISO 9075 ") then
               MOVE 0 TO flag
             END-IF

             if (odsflg  =  1) then
               GO TO P185
             END-IF
             DISPLAY "sco should be 'ISO 9075 '; its value is ", sco
             if (sco  NOT  =   "ISO 9075 ") then
               MOVE 0 TO flag
             END-IF
             GO TO P184
           .
        P185.
             DISPLAY "sco should NOT be 'ISO 9075 '; its value is ",
             sco
             if (sco   =   "ISO 9075 ") then
               MOVE 0 TO flag
             END-IF

           .
        P184.
             DISPLAY "nl1 should be ' '; its value is '", nl1 "'"
             if (nl1  NOT  =   " ") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "snam should be 'HU '; its value is '", snam "'"
             if (snam  NOT  =   "HU ") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "tnam should be 'VTABL'; its value is '", tnam "'"
             if (tnam  NOT  =   "VTABL") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "cnam should be 'COL1'; its value is '", cnam "'"
             if (cnam  NOT  =   "COL1") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "nl5 should be ' '; its value is '", nl5 "'"
             if (nl5  NOT  =   " ") then
               MOVE 0 TO flag
             END-IF

             DISPLAY "mtxt should be meaningful or blank; its value is
      -    " '", mtxt "'"
             if (mtxt   =
             "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "mlen should be >= 0; its value is ", mlen
             DISPLAY "omlen should be >= 0; its value is ", omlen
             if (mlen  <  0  OR  omlen  <  0) then
               MOVE 0 TO flag
             END-IF

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

           PERFORM CHCKOK
             DISPLAY  " "

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

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

      *  EXEC SQL COMMIT WORK;
             CALL "SUB14" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
      ******************** END TEST0667 ********************
      ******************** BEGIN TEST0668 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0668 "
             DISPLAY " Diagnostics: COMMAND_FUNCTION (static)"
             DISPLAY "References:"
             DISPLAY " F# 12 -- Get diagnostics"
             DISPLAY " 18.1 -- "
             DISPLAY " TC #2 18.1 -- unrecognized statements"
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             COMPUTE SQLCODE = -1
             MOVE "xxxxx" TO SQLSTATE

      *COMMIT WORK
      *Even if we get an invalid transaction state it should still
      *set COMMAND_FUNCTION

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

      *This verifies that GET DIAGNOSTICS sets SQLSTATE
             COMPUTE SQLCODE = -1
             MOVE "xxxxx" TO SQLSTATE

             MOVE "xxxxxxxxxxxxxxx" TO cmd
             DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
      *  EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
             CALL "SUB16" USING SQLCODE SQLSTATE cmd
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "cmd should be 'COMMIT WORK '; its value is ",
             cmd
             if (cmd  NOT  =   "COMMIT WORK ") then
               MOVE 0 TO flag
             END-IF

      *SELECT

             DISPLAY "SELECT COUNT(*) INTO :int1 FROM USIG;"
      *  EXEC SQL SELECT COUNT(*) INTO :int1 FROM USIG;
             CALL "SUB17" USING SQLCODE SQLSTATE int1
             MOVE SQLCODE TO SQL-COD

             MOVE "xxxxxxxxxxxxxxx" TO cmd
             DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
      *  EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
             CALL "SUB18" USING SQLCODE SQLSTATE cmd
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "cmd should be 'SELECT '; its value is ",
             cmd
             if (cmd  NOT  =   "SELECT ") then
               MOVE 0 TO flag
             END-IF

      *DELETE WHERE

             DISPLAY "DELETE FROM CONCATBUF;"
      *  EXEC SQL DELETE FROM CONCATBUF;
             CALL "SUB19" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

             MOVE "xxxxxxxxxxxxxxx" TO cmd
             DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
      *  EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
             CALL "SUB20" USING SQLCODE SQLSTATE cmd
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "cmd should be 'DELETE WHERE '; its value is ",
             cmd
             if (cmd  NOT  =   "DELETE WHERE ") then
               MOVE 0 TO flag
             END-IF

      *INSERT

             DISPLAY "INSERT INTO CONCATBUF VALUES ('fnord');"
      *  EXEC SQL INSERT INTO CONCATBUF VALUES ('fnord');
             CALL "SUB21" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

             MOVE "xxxxxxxxxxxxxxx" TO cmd
             DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
      *  EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
             CALL "SUB22" USING SQLCODE SQLSTATE cmd
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "cmd should be 'INSERT '; its value is ",
             cmd
             if (cmd  NOT  =   "INSERT ") then
               MOVE 0 TO flag
             END-IF

      *UPDATE WHERE

             DISPLAY "UPDATE CONCATBUF SET ZZ = 'moby'"
             DISPLAY " WHERE ZZ = 'fnord';"
      *  EXEC SQL UPDATE CONCATBUF SET ZZ = 'moby'
      *    WHERE ZZ = 'fnord';
             CALL "SUB23" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

             MOVE "xxxxxxxxxxxxxxx" TO cmd
             DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
      *  EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
             CALL "SUB24" USING SQLCODE SQLSTATE cmd
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "cmd should be 'UPDATE WHERE '; its value is ",
             cmd
             if (cmd  NOT  =   "UPDATE WHERE ") then
               MOVE 0 TO flag
             END-IF

      *OPEN

             DISPLAY "DECLARE C12741 CURSOR FOR"
             DISPLAY " SELECT ZZ FROM CONCATBUF;"
      *  EXEC SQL DECLARE C12741 CURSOR FOR
      *    SELECT ZZ FROM CONCATBUF END-EXEC

             DISPLAY "OPEN C12741;"
      *  EXEC SQL OPEN C12741;
             CALL "SUB25" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

             MOVE "xxxxxxxxxxxxxxx" TO cmd
             DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
      *  EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
             CALL "SUB26" USING SQLCODE SQLSTATE cmd
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "cmd should be 'OPEN '; its value is ",
             cmd
             if (cmd  NOT  =   "OPEN ") then
               MOVE 0 TO flag
             END-IF

      *FETCH

             DISPLAY "FETCH C12741 INTO :cmd;"
      *  EXEC SQL FETCH C12741 INTO :cmd;
             CALL "SUB27" USING SQLCODE SQLSTATE cmd
             MOVE SQLCODE TO SQL-COD

             MOVE "xxxxxxxxxxxxxxx" TO cmd
             DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
      *  EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
             CALL "SUB28" USING SQLCODE SQLSTATE cmd
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "cmd should be 'FETCH '; its value is ",
             cmd
             if (cmd  NOT  =   "FETCH ") then
               MOVE 0 TO flag
             END-IF

      *UPDATE CURSOR

             DISPLAY "UPDATE CONCATBUF"
             DISPLAY " SET ZZ = 'clobber' WHERE CURRENT OF C12741;"
      *  EXEC SQL UPDATE CONCATBUF
      *    SET ZZ = 'clobber' WHERE CURRENT OF C12741;
             CALL "SUB29" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

             MOVE "xxxxxxxxxxxxxxx" TO cmd
             DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
      *  EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
             CALL "SUB30" USING SQLCODE SQLSTATE cmd
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "cmd should be 'UPDATE CURSOR '; its value is ",
             cmd
             if (cmd  NOT  =   "UPDATE CURSOR ") then
               MOVE 0 TO flag
             END-IF

      *DELETE CURSOR (<delete statement: positioned>)

             DISPLAY "DELETE FROM CONCATBUF WHERE CURRENT OF C12741;"
      *  EXEC SQL DELETE FROM CONCATBUF WHERE CURRENT OF C12741
      * ;
             CALL "SUB31" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

             MOVE "xxxxxxxxxxxxxxx" TO cmd
             DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
      *  EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
             CALL "SUB32" USING SQLCODE SQLSTATE cmd
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "cmd should be 'DELETE CURSOR '; its value is ",
             cmd
             if (cmd  NOT  =   "DELETE CURSOR ") then
               MOVE 0 TO flag
             END-IF

      *CLOSE CURSOR

             DISPLAY "CLOSE C12741;"
      *  EXEC SQL CLOSE C12741;
             CALL "SUB33" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

             MOVE "xxxxxxxxxxxxxxx" TO cmd
             DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
      *  EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
             CALL "SUB34" USING SQLCODE SQLSTATE cmd
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "cmd should be 'CLOSE CURSOR '; its value is ",
             cmd
             if (cmd  NOT  =   "CLOSE CURSOR ") then
               MOVE 0 TO flag
             END-IF

      *Unrecognized statement:  TC #2 18.1
      *If your database recognizes FROB, change it to a command
      *that it doesn't recognize.  If unrecognized statements are
      *rejected at compile time, TEd this part out.

             DISPLAY "FROB;"
      *  EXEC SQL FROB;
             CALL "SUB35" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

             MOVE "xxxxxxxxxxxxxxx" TO cmd
             DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
      *  EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
             CALL "SUB36" USING SQLCODE SQLSTATE cmd
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "cmd should be ' '; its value is '", cmd "'"
             if (cmd  NOT  =   " ") then
               MOVE 0 TO flag
             END-IF

      *ROLLBACK WORK

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

           PERFORM CHCKOK
             DISPLAY  " "

             MOVE "xxxxxxxxxxxxxxx" TO cmd
             DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
      *  EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
             CALL "SUB38" USING SQLCODE SQLSTATE cmd
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "cmd should be 'ROLLBACK WORK '; its value is ",
             cmd
             if (cmd  NOT  =   "ROLLBACK WORK ") then
               MOVE 0 TO flag
             END-IF

      *For future reference:  these cannot be tested in Trans SQL

      *ALLOCATE CURSOR:  Full SQL
      *ALTER DOMAIN:  Intermediate SQL
      *CREATE ASSERTION:  Full SQL
      *CREATE CHARACTER SET:  Intermediate SQL
      *CREATE COLLATION:  Full SQL
      *CONNECT:  Full SQL
      *DEALLOCATE PREPARE:  Full SQL
      *DISCONNECT:  Full SQL
      *CREATE DOMAIN:  Intermediate SQL
      *DROP ASSERTION:  Full SQL
      *DROP CHARACTER SET:  Intermediate SQL
      *DROP COLLATION:  Full SQL
      *DROP DOMAIN:  Intermediate SQL
      *DROP SCHEMA:  Intermediate SQL
      *DROP TRANSLATION:  Full SQL
      *CREATE SCHEMA:  Intermediate SQL
      *SET CATALOG:  Full SQL
      *SET CONNECTION:  Full SQL
      *SET CONSTRAINT:  Full SQL
      *SET TIME ZONE:  Intermediate SQL
      *SET NAMES:  Full SQL
      *SET SCHEMA:  Full SQL
      *SET SESSION AUTHORIZATION:  Intermediate SQL
      *CREATE TRANSLATION:  Full SQL

      *GET DIAGNOSTICS  F# 12  Can't happen

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

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

      *  EXEC SQL COMMIT WORK;
             CALL "SUB41" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
      ******************** END TEST0668 ********************
      ******************** BEGIN TEST0669 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0669 "
             DISPLAY "Diagnostics: COMMAND_FUNCTION F# 3, 11"
             DISPLAY "References:"
             DISPLAY " F# 12 -- Get diagnostics"
             DISPLAY " 18.1 -- "
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             COMPUTE SQLCODE = -1
             MOVE "xxxxx" TO SQLSTATE

      *SET TRANSACTION  F# 11

             DISPLAY "SET TRANSACTION ISOLATION LEVEL SERIALIZABLE;"
      *  EXEC SQL SET TRANSACTION ISOLATION LEVEL SERIALIZABLE
      * ;
             CALL "SUB42" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

             MOVE "xxxxxxxxxxxxxxx" TO cmd
             DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
      *  EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
             CALL "SUB43" USING SQLCODE SQLSTATE cmd
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "cmd should be 'SET TRANSACTION'; its value is ",
             cmd
             if (cmd  NOT  =   "SET TRANSACTION") then
               MOVE 0 TO flag
             END-IF

      *CREATE VIEW  F# 3

             DISPLAY "CREATE VIEW BEABLE AS"
             DISPLAY " SELECT ZZ FROM CONCATBUF;"
      *  EXEC SQL CREATE VIEW BEABLE AS
      *    SELECT ZZ FROM CONCATBUF;
             CALL "SUB44" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

             MOVE "xxxxxxxxxxxxxxx" TO cmd
             DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
      *  EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
             CALL "SUB45" USING SQLCODE SQLSTATE cmd
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "cmd should be 'CREATE VIEW '; its value is ",
             cmd
             if (cmd  NOT  =   "CREATE VIEW ") then
               MOVE 0 TO flag
             END-IF

      *CREATE TABLE  F# 3

             DISPLAY "CREATE TABLE SLACK ("
             DISPLAY " NAAM CHAR (10), DONATION DECIMAL (5, 2));"
      *  EXEC SQL CREATE TABLE SLACK (
      *    NAAM CHAR (10), DONATION DECIMAL (5, 2));
             CALL "SUB46" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

             MOVE "xxxxxxxxxxxxxxx" TO cmd
             DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
      *  EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
             CALL "SUB47" USING SQLCODE SQLSTATE cmd
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "cmd should be 'CREATE TABLE '; its value is ",
             cmd
             if (cmd  NOT  =   "CREATE TABLE ") then
               MOVE 0 TO flag
             END-IF

      *ALTER TABLE   F# 3

             DISPLAY "ALTER TABLE SLACK"
             DISPLAY " ADD COLUMN KIBO_NUMBER INT;"
      *  EXEC SQL ALTER TABLE SLACK
      *    ADD COLUMN KIBO_NUMBER INT;
             CALL "SUB48" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

             MOVE "xxxxxxxxxxxxxxx" TO cmd
             DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
      *  EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
             CALL "SUB49" USING SQLCODE SQLSTATE cmd
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "cmd should be 'ALTER TABLE '; its value is ",
             cmd
             if (cmd  NOT  =   "ALTER TABLE ") then
               MOVE 0 TO flag
             END-IF

      *GRANT  F# 3

             DISPLAY "GRANT ALL PRIVILEGES ON SLACK TO PUBLIC;"
      *  EXEC SQL GRANT ALL PRIVILEGES ON SLACK TO PUBLIC;
             CALL "SUB50" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

             MOVE "xxxxxxxxxxxxxxx" TO cmd
             DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
      *  EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
             CALL "SUB51" USING SQLCODE SQLSTATE cmd
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "cmd should be 'GRANT '; its value is ",
             cmd
             if (cmd  NOT  =   "GRANT ") then
               MOVE 0 TO flag
             END-IF

      *REVOKE  F# 3

             DISPLAY "REVOKE INSERT ON SLACK FROM PUBLIC CASCADE;"
      *  EXEC SQL REVOKE INSERT ON SLACK FROM PUBLIC CASCADE
      * ;
             CALL "SUB52" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

             MOVE "xxxxxxxxxxxxxxx" TO cmd
             DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
      *  EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
             CALL "SUB53" USING SQLCODE SQLSTATE cmd
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "cmd should be 'REVOKE '; its value is ",
             cmd
             if (cmd  NOT  =   "REVOKE ") then
               MOVE 0 TO flag
             END-IF

      *DROP TABLE  F# 3

             DISPLAY "DROP TABLE SLACK RESTRICT;"
      *  EXEC SQL DROP TABLE SLACK RESTRICT;
             CALL "SUB54" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

             MOVE "xxxxxxxxxxxxxxx" TO cmd
             DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
      *  EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
             CALL "SUB55" USING SQLCODE SQLSTATE cmd
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "cmd should be 'DROP TABLE '; its value is ",
             cmd
             if (cmd  NOT  =   "DROP TABLE ") then
               MOVE 0 TO flag
             END-IF

      *DROP VIEW  F# 3

             DISPLAY "DROP VIEW BEABLE RESTRICT;"
      *  EXEC SQL DROP VIEW BEABLE RESTRICT;
             CALL "SUB56" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD

             MOVE "xxxxxxxxxxxxxxx" TO cmd
             DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;"
      *  EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION;
             CALL "SUB57" USING SQLCODE SQLSTATE cmd
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "cmd should be 'DROP VIEW '; its value is ",
             cmd
             if (cmd  NOT  =   "DROP VIEW ") then
               MOVE 0 TO flag
             END-IF

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

           PERFORM CHCKOK
             DISPLAY  " "

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

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

      *  EXEC SQL COMMIT WORK;
             CALL "SUB61" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
      ******************** END TEST0669 ********************
      ******************** BEGIN TEST0672 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0672 "
             DISPLAY " Diagnostics: Multiple conditions"
             DISPLAY "References:"
             DISPLAY " F# 12 -- Get diagnostics"
             DISPLAY " F# 11 -- Transaction isolation"
             DISPLAY " 18.1 -- "
             DISPLAY " TC #2 4.18.1 -- precedence rules for SQLSTATE"
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             COMPUTE SQLCODE = -1
             MOVE "xxxxx" TO SQLSTATE

             DISPLAY "CREATE TABLE DOUBLE_TROUBLE ("
             DISPLAY " TOO_LITTLE CHAR (10), TOO_LATE CHAR (10));"
      *  EXEC SQL CREATE TABLE DOUBLE_TROUBLE (
      *    TOO_LITTLE CHAR (10), TOO_LATE CHAR (10));
             CALL "SUB62" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "COMMIT WORK;"
      *  EXEC SQL COMMIT WORK;
             CALL "SUB63" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "INSERT INTO DOUBLE_TROUBLE VALUES ('Albatross!',
      -    " NULL);"
      *  EXEC SQL INSERT INTO DOUBLE_TROUBLE VALUES ('Albatross!',
      *  NULL);
             CALL "SUB64" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "COMMIT WORK;"
      *  EXEC SQL COMMIT WORK;
             CALL "SUB65" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             MOVE 2 TO int1
             DISPLAY "int1 = 2"
             DISPLAY "SET TRANSACTION DIAGNOSTICS SIZE :int1;"
      *  EXEC SQL SET TRANSACTION DIAGNOSTICS SIZE :int1;
             CALL "SUB66" USING SQLCODE SQLSTATE int1
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *Simultaneously generate a string data, right truncation warning
      *and a null value, no indicator parameter exception.  Since one
      *is a warning and the other is an error, we know what order they
      *should be in.  See TC #2 4.18.1.

             DISPLAY "SELECT * INTO :nl1, :mtxt FROM DOUBLE_TROUBLE;"
      *  EXEC SQL SELECT * INTO :nl1, :mtxt FROM DOUBLE_TROUBLE
      * ;
             CALL "SUB67" USING SQLCODE SQLSTATE nl1 mtxt
             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 (SQLSTATE  NOT  =   "22002") then
               MOVE 0 TO flag
             END-IF

             COMPUTE num = -1
             DISPLAY "GET DIAGNOSTICS :num = NUMBER;"
      *  EXEC SQL GET DIAGNOSTICS :num = NUMBER;
             CALL "SUB68" USING SQLCODE SQLSTATE num
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "num should be 1 or 2; its value is ", num
             if (num  NOT =  2  AND  num  NOT =  1) then
               MOVE 0 TO flag
             END-IF

             COMPUTE int1 = -1
             MOVE "xxxxx" TO st
             MOVE "xxxxxxxxxxx" TO co
             MOVE "xxxxxxxxxxx" TO sco
             MOVE "x" TO nl1
             MOVE "x" TO nl2
             MOVE "x" TO nl3
             MOVE "x" TO nl4
             MOVE "x" TO nl5
             MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
             TO mtxt
             COMPUTE mlen = -1
             COMPUTE omlen = -1
             DISPLAY "GET DIAGNOSTICS EXCEPTION 1"
             DISPLAY " :int1 = CONDITION_NUMBER, :st =
      -    " RETURNED_SQLSTATE,"
             DISPLAY " :co = CLASS_ORIGIN, :sco = SUBCLASS_ORIGIN,"
             DISPLAY " :nl1 = CONSTRAINT_SCHEMA, :nl2 = SCHEMA_NAME,"
             DISPLAY " :nl3 = TABLE_NAME, :nl4 = COLUMN_NAME,"
             DISPLAY " :nl5 = CURSOR_NAME, :mtxt = MESSAGE_TEXT,"
             DISPLAY " :mlen = MESSAGE_LENGTH, :omlen =
      -    " MESSAGE_OCTET_LENGTH;"
      *  EXEC SQL GET DIAGNOSTICS EXCEPTION 1
      *    :int1 = CONDITION_NUMBER, :st = RETURNED_SQLSTATE,
      *    :co = CLASS_ORIGIN, :sco = SUBCLASS_ORIGIN,
      *    :nl1 = CONSTRAINT_SCHEMA, :nl2 = SCHEMA_NAME,
      *    :nl3 = TABLE_NAME, :nl4 = COLUMN_NAME,
      *    :nl5 = CURSOR_NAME, :mtxt = MESSAGE_TEXT,
      *    :mlen = MESSAGE_LENGTH, :omlen = MESSAGE_OCTET_LENGTH
      * ;
             CALL "SUB69" USING SQLCODE SQLSTATE
                  int1 st co sco nl1 nl2 nl3 nl4
             nl5 mtxt mlen omlen
             MOVE SQLCODE TO SQL-COD
             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 01004; its value is ",
             SQLSTATE
           PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (NORMSQ  NOT  =   "00000"  AND  NORMSQ  NOT  =
             "01004") then
               MOVE 0 TO flag
             END-IF
             if (NORMSQ   =   "00000"  AND  NORMSQ  NOT  =   SQLSTATE)
             then
               DISPLAY "Valid implementation-defined SQLSTATE accepted."
             END-IF
             DISPLAY "int1 should be 1; its value is ", int1
             if (int1  NOT =  1) then
               MOVE 0 TO flag
             END-IF
             DISPLAY "st should be 22002; its value is ", st
             if (st  NOT  =   "22002") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "co should be 'ISO 9075 '; its value is ", co
             if (co  NOT  =   "ISO 9075 ") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "sco should be 'ISO 9075 '; its value is ", sco
             if (sco  NOT  =   "ISO 9075 ") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "nl1 should be ' '; its value is '", nl1 "'"
             if (nl1  NOT  =   " ") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "nl2 should be ' '; its value is '", nl2 "'"
             if (nl2  NOT  =   " ") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "nl3 should be ' '; its value is '", nl3 "'"
             if (nl3  NOT  =   " ") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "nl4 should be ' '; its value is '", nl4 "'"
             if (nl4  NOT  =   " ") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "nl5 should be ' '; its value is '", nl5 "'"
             if (nl5  NOT  =   " ") then
               MOVE 0 TO flag
             END-IF

             DISPLAY "mtxt should be meaningful or blank; its value is
      -    " '", mtxt "'"
             if (mtxt   =
             "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "mlen should be >= 0; its value is ", mlen
             DISPLAY "omlen should be >= 0; its value is ", omlen
             if (mlen  <  0  OR  omlen  <  0) then
               MOVE 0 TO flag
             END-IF

             if (num  =  1) then
               DISPLAY "Skipping rest of test because NUMBER = 1"
               GO TO P183
             END-IF

             COMPUTE int1 = -1
             MOVE 2 TO int2
             DISPLAY "int2 = 2"
             MOVE "xxxxx" TO st
             MOVE "xxxxxxxxxxx" TO co
             MOVE "xxxxxxxxxxx" TO sco
             MOVE "x" TO nl1
             MOVE "x" TO nl2
             MOVE "x" TO nl3
             MOVE "x" TO nl4
             MOVE "x" TO nl5
             MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
             TO mtxt
             COMPUTE mlen = -1
             COMPUTE omlen = -1
             DISPLAY "GET DIAGNOSTICS EXCEPTION :int2"
             DISPLAY " :int1 = CONDITION_NUMBER, :st =
      -    " RETURNED_SQLSTATE,"
             DISPLAY " :co = CLASS_ORIGIN, :sco = SUBCLASS_ORIGIN,"
             DISPLAY " :nl1 = CONSTRAINT_SCHEMA, :nl2 = SCHEMA_NAME,"
             DISPLAY " :nl3 = TABLE_NAME, :nl4 = COLUMN_NAME,"
             DISPLAY " :nl5 = CURSOR_NAME, :mtxt = MESSAGE_TEXT,"
             DISPLAY " :mlen = MESSAGE_LENGTH, :omlen =
      -    " MESSAGE_OCTET_LENGTH;"
      *  EXEC SQL GET DIAGNOSTICS EXCEPTION :int2
      *    :int1 = CONDITION_NUMBER, :st = RETURNED_SQLSTATE,
      *    :co = CLASS_ORIGIN, :sco = SUBCLASS_ORIGIN,
      *    :nl1 = CONSTRAINT_SCHEMA, :nl2 = SCHEMA_NAME,
      *    :nl3 = TABLE_NAME, :nl4 = COLUMN_NAME,
      *    :nl5 = CURSOR_NAME, :mtxt = MESSAGE_TEXT,
      *    :mlen = MESSAGE_LENGTH, :omlen = MESSAGE_OCTET_LENGTH
      * ;
             CALL "SUB70" USING SQLCODE SQLSTATE
                  int2 int1 st co sco nl1 nl2 nl3
             nl4 nl5 mtxt mlen omlen
             MOVE SQLCODE TO SQL-COD
             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 01004; its value is ",
             SQLSTATE
           PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (NORMSQ  NOT  =   "00000"  AND  NORMSQ  NOT  =
             "01004") then
               MOVE 0 TO flag
             END-IF
             if (NORMSQ   =   "00000"  AND  NORMSQ  NOT  =   SQLSTATE)
             then
               DISPLAY "Valid implementation-defined SQLSTATE accepted."
             END-IF
             DISPLAY "int1 should be 2; its value is ", int1
             if (int1  NOT =  2) then
               MOVE 0 TO flag
             END-IF
             DISPLAY "co is ", co
             DISPLAY "sco is ", sco
             if (co  NOT  =   "ISO 9075 "  OR  sco  NOT  =   "ISO 9075
      -    " ") then
               DISPLAY "Skipping remainder because of imp-defined
      -    " SQLSTATE"
               GO TO P183
             END-IF
             DISPLAY "st should be 01004; its value is ", st
             if (st  NOT  =   "01004") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "nl1 should be ' '; its value is '", nl1 "'"
             if (nl1  NOT  =   " ") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "nl2 should be ' '; its value is '", nl2 "'"
             if (nl2  NOT  =   " ") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "nl3 should be ' '; its value is '", nl3 "'"
             if (nl3  NOT  =   " ") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "nl4 should be ' '; its value is '", nl4 "'"
             if (nl4  NOT  =   " ") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "nl5 should be ' '; its value is '", nl5 "'"
             if (nl5  NOT  =   " ") then
               MOVE 0 TO flag
             END-IF

             DISPLAY "mtxt should be meaningful or blank; its value is
      -    " '", mtxt "'"
             if (mtxt   =
             "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "mlen should be >= 0; its value is ", mlen
             DISPLAY "omlen should be >= 0; its value is ", omlen
             if (mlen  <  0  OR  omlen  <  0) then
               MOVE 0 TO flag
             END-IF

           .
        P183.
             DISPLAY "ROLLBACK WORK;"
      *  EXEC SQL ROLLBACK WORK;
             CALL "SUB71" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *Check sytax:  <number of conditions> as a literal

             DISPLAY "SET TRANSACTION DIAGNOSTICS SIZE 2;"
      *  EXEC SQL SET TRANSACTION DIAGNOSTICS SIZE 2;
             CALL "SUB72" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "ROLLBACK WORK;"
      *  EXEC SQL ROLLBACK WORK;
             CALL "SUB73" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "DROP TABLE DOUBLE_TROUBLE CASCADE;"
      *  EXEC SQL DROP TABLE DOUBLE_TROUBLE CASCADE;
             CALL "SUB74" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "COMMIT WORK;"
      *  EXEC SQL COMMIT WORK;
             CALL "SUB75" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

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

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

      *  EXEC SQL COMMIT WORK;
             CALL "SUB78" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
      ******************** END TEST0672 ********************
      ******************** BEGIN TEST0673 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0673 "
             DISPLAY " Diagnostics SQLSTATE: inv. cond. number"
             DISPLAY "References:"
             DISPLAY " F# 12 -- Get diagnostics"
             DISPLAY " 18.1 GR.2"
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             COMPUTE SQLCODE = -1
             MOVE "xxxxx" TO SQLSTATE

             DISPLAY "GET DIAGNOSTICS EXCEPTION 0"
             DISPLAY " :int2 = CONDITION_NUMBER;"
      *  EXEC SQL GET DIAGNOSTICS EXCEPTION 0
      *    :int2 = CONDITION_NUMBER;
             CALL "SUB79" USING SQLCODE SQLSTATE int2
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             if (SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF
             DISPLAY "SQLSTATE should be 35000; its value is ", SQLSTATE
             if (SQLCODE  NOT <  0  OR  NORMSQ  NOT  =   "35000") then
               MOVE 0 TO flag
             END-IF
             if (NORMSQ   =   "35000"  AND  NORMSQ  NOT  =   SQLSTATE)
             then
               DISPLAY "Valid implementation-defined SQLSTATE accepted."
             END-IF
             DISPLAY  " "

             COMPUTE int1 = -1
             DISPLAY "int1 = -1"
             DISPLAY "GET DIAGNOSTICS EXCEPTION :int1"
             DISPLAY " :int2 = CONDITION_NUMBER;"
      *  EXEC SQL GET DIAGNOSTICS EXCEPTION :int1
      *    :int2 = CONDITION_NUMBER;
             CALL "SUB80" USING SQLCODE SQLSTATE int1 int2
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             if (SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF
             DISPLAY "SQLSTATE should be 35000; its value is ", SQLSTATE
             if (SQLCODE  NOT <  0  OR  NORMSQ  NOT  =   "35000") then
               MOVE 0 TO flag
             END-IF
             if (NORMSQ   =   "35000"  AND  NORMSQ  NOT  =   SQLSTATE)
             then
               DISPLAY "Valid implementation-defined SQLSTATE accepted."
             END-IF
             DISPLAY  " "

             DISPLAY "ROLLBACK WORK;"
      *  EXEC SQL ROLLBACK WORK;
             CALL "SUB81" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

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

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

      *  EXEC SQL COMMIT WORK;
             CALL "SUB84" USING SQLCODE SQLSTATE
             MOVE SQLCODE TO SQL-COD
      ******************** END TEST0673 ********************
      **** 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.

quality99%

¤ Dauer der Verarbeitung: 0.38 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.