Quelle  dml127.cob   Sprache: Cobol

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


      * EMBEDDED COBOL (file "DML127.PCO")


      ****************************************************************
      *                                                              
      *                 COMMENT SECTION                              
      *                                                              
      * DATE 1994/7/11 EMBEDDED COBOL LANGUAGE                           
      * NIST SQL VALIDATION TEST SUITE V6.0                          
      *  DISCLAIMER:                                                  
      *  This program was written by employees of NIST to test SQL    
      *  implementations for conformance to the SQL standards.        
      *  NIST assumes no responsibility for any party's use of        
      *  this program.
      *                                                              
      * DML127.PCO                                                    
      * WRITTEN BY:  David W. Flater                                 
      * TRANSLATED AUTOMATICALLY FROM EMBEDDED C 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  smint1 PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
       01  yorn PIC  X(1).
       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  cns PIC  X(2).
       01  snam PIC  X(6).
       01  tnam PIC  X(5).
       01  csrnam PIC  X(6).
             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 END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL ROLLBACK WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (uid  NOT  =   uidx) then
               DISPLAY "ERROR: User ", uid " expected. User ", uidx "
      -    " connected"
            STOP RUN
             END-IF
             MOVE 0 TO errcnt

             DISPLAY
           "SQL Test Suite, V6.0, Embedded COBOL, dml127.pco"
             DISPLAY
           "59-byte ID"
             DISPLAY "TEd Version #"
      *date_time print 
           ACCEPT TO-DAY FROM DATE
           ACCEPT THE-TIME FROM TIME
           DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIME

      ******************** BEGIN TEST0665 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0665 "
             DISPLAY " Diagnostics: statement information"
             DISPLAY "References:"
             DISPLAY " F# 12 -- Get diagnostics"
             DISPLAY " 18.1 -- "
             DISPLAY " 18.1 GR.1.b -- MORE"
             DISPLAY " 18.1 GR.1.c -- COMMAND_FUNCTION"
             DISPLAY " 18.1 GR.1.e -- ROW_COUNT"
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             COMPUTE SQLCODE = -1
             MOVE "xxxxx" TO SQLSTATE

      *COMMAND_FUNCTION and DYNAMIC_FUNCTION are tested elsewhere 

      *It is difficult to check the values of NUMBER and MORE because 
      *there may be an arbitrary number of implementation-defined     
      *warnings given with each statement.                            

             DISPLAY "SELECT COUNT(*) INTO :int1 FROM HU.ECCO;"
             EXEC SQL SELECT COUNT(*) INTO :int1 FROM HU.ECCO END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             COMPUTE int1 = -1
             MOVE "x" TO yorn
             MOVE "xxxxxxxxxxxxxxx" TO cmd
             DISPLAY "GET DIAGNOSTICS :int1 = NUMBER,"
             DISPLAY " :yorn = MORE, :cmd = COMMAND_FUNCTION;"
             EXEC SQL GET DIAGNOSTICS :int1 = NUMBER,
               :yorn = MORE, :cmd = COMMAND_FUNCTION END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "int1 should be > 0; its value is ", int1
             DISPLAY "yorn should be Y or N; its value is ", yorn
             DISPLAY "cmd should be 'SELECT '; its value is ",
             cmd
             if (int1  NOT >  0) then
               MOVE 0 TO flag
             END-IF
             if (yorn  NOT  =   "Y"  AND  yorn  NOT  =   "N") then
               MOVE 0 TO flag
             END-IF
             if (cmd  NOT  =   "SELECT ") then
               MOVE 0 TO flag
             END-IF

      *Mass firings and layoffs. 

             DISPLAY "DELETE FROM HU.STAFF WHERE GRADE < 13;"
             EXEC SQL DELETE FROM HU.STAFF WHERE GRADE < 13 END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             COMPUTE int1 = -1
             COMPUTE int2 = -1
             MOVE "x" TO yorn
             MOVE "xxxxxxxxxxxxxxx" TO cmd
             DISPLAY "GET DIAGNOSTICS :cmd = COMMAND_FUNCTION,"
             DISPLAY " :int2 = ROW_COUNT,"
             DISPLAY " :yorn = MORE, "
             DISPLAY " :int1 = NUMBER;"
             EXEC SQL GET DIAGNOSTICS :cmd = COMMAND_FUNCTION,
               :int2 = ROW_COUNT,
               :yorn = MORE, 
               :int1 = NUMBER END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "int1 should be > 0; its value is ", int1
             DISPLAY "yorn should be Y or N; its value is ", yorn
             DISPLAY "cmd should be 'DELETE WHERE '; its value is ",
             cmd
             DISPLAY "int2 should be 3; its value is ", int2
             if (int1  NOT >  0  OR  int2  NOT =  3) then
               MOVE 0 TO flag
             END-IF
             if (yorn  NOT  =   "Y"  AND  yorn  NOT  =   "N") then
               MOVE 0 TO flag
             END-IF
             if (cmd  NOT  =   "DELETE WHERE ") then
               MOVE 0 TO flag
             END-IF

      *Pay cuts, benefits reductions. 

             DISPLAY "UPDATE HU.STAFF SET GRADE = GRADE - 1;"
             EXEC SQL UPDATE HU.STAFF SET GRADE = GRADE - 1 END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             COMPUTE smint1 = -1
             COMPUTE int2 = -1
             MOVE "x" TO yorn
             MOVE "xxxxxxxxxxxxxxx" TO cmd
             DISPLAY "GET DIAGNOSTICS :smint1 = NUMBER,"
             DISPLAY " :yorn = MORE, :cmd = COMMAND_FUNCTION,"
             DISPLAY " :int2 = ROW_COUNT;"
             EXEC SQL GET DIAGNOSTICS :smint1 = NUMBER,
               :yorn = MORE, :cmd = COMMAND_FUNCTION,
               :int2 = ROW_COUNT END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "smint1 should be > 0; its value is ", smint1
             DISPLAY "yorn should be Y or N; its value is ", yorn
             DISPLAY "cmd should be 'UPDATE WHERE '; its value is ",
             cmd
             DISPLAY "int2 should be 2; its value is ", int2
             if (smint1  NOT >  0  OR  int2  NOT =  2) then
               MOVE 0 TO flag
             END-IF
             if (yorn  NOT  =   "Y"  AND  yorn  NOT  =   "N") then
               MOVE 0 TO flag
             END-IF
             if (cmd  NOT  =   "UPDATE WHERE ") then
               MOVE 0 TO flag
             END-IF

      *Simultaneous hiring of cheap labor. 

             DISPLAY "INSERT INTO HU.STAFF"
             DISPLAY " SELECT PNUM, 'Temp Worker', 4, CITY FROM
      -    " HU.PROJ;"
             EXEC SQL INSERT INTO HU.STAFF
               SELECT PNUM, 'Temp Worker', 4, CITY FROM HU.PROJ END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             COMPUTE int1 = -1
             COMPUTE int2 = -1
             MOVE "x" TO yorn
             MOVE "xxxxxxxxxxxxxxx" TO cmd
             DISPLAY "GET DIAGNOSTICS :int1 = NUMBER,"
             DISPLAY " :yorn = MORE, :cmd = COMMAND_FUNCTION,"
             DISPLAY " :int2 = ROW_COUNT;"
             EXEC SQL GET DIAGNOSTICS :int1 = NUMBER,
               :yorn = MORE, :cmd = COMMAND_FUNCTION,
               :int2 = ROW_COUNT END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "int1 should be > 0; its value is ", int1
             DISPLAY "yorn should be Y or N; its value is ", yorn
             DISPLAY "cmd should be 'INSERT '; its value is ",
             cmd
             DISPLAY "int2 should be 6; its value is ", int2
             if (int1  NOT >  0  OR  int2  NOT =  6) then
               MOVE 0 TO flag
             END-IF
             if (yorn  NOT  =   "Y"  AND  yorn  NOT  =   "N") then
               MOVE 0 TO flag
             END-IF
             if (cmd  NOT  =   "INSERT ") then
               MOVE 0 TO flag
             END-IF

      *Destruction of evidence. 

             DISPLAY "ROLLBACK WORK;"
             EXEC SQL ROLLBACK WORK END-EXEC
             MOVE SQLCODE TO SQL-COD

           PERFORM CHCKOK
             DISPLAY  " "

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0665','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml127.pco *** fail *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0665','fail','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
             END-IF

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

             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
      ******************** END TEST0665 ********************
      ******************** BEGIN TEST0666 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0666 "
             DISPLAY " Diagnostics: condition information"
             DISPLAY "References:"
             DISPLAY " F# 12 -- Get diagnostics"
             DISPLAY " 18.1 -- "
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             COMPUTE SQLCODE = -1
             MOVE "xxxxx" TO SQLSTATE

      *Multiple conditions are tested elsewhere 

      *Subtest 1:  boring select. 

             DISPLAY "SELECT COUNT(*) INTO :int1 FROM HU.ECCO;"
             EXEC SQL SELECT COUNT(*) INTO :int1 FROM HU.ECCO END-EXEC
             MOVE SQLCODE TO SQL-COD
             MOVE SQLSTATE TO olds
           PERFORM CHCKOK
             DISPLAY  " "
             MOVE 0 TO odsflg
             if (NORMSQ   =   "00000"  AND  NORMSQ  NOT  =   SQLSTATE)
             then
               MOVE 1 TO odsflg
             END-IF

             COMPUTE smint1 = -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 " :smint1 = 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
               :smint1 = 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
             END-EXEC
             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 "smint1 should be 1; its value is ", smint1
             if (smint1  NOT =  1) then
               MOVE 0 TO flag
             END-IF
      *Verify RETURNED_SQLSTATE matches SELECT's SQLSTATE 
             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 P198
             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 P199
           .
        P198.
             DISPLAY "sco should NOT be 'ISO 9075 '; its value is ",
             sco
             if (sco   =   "ISO 9075 ") then
               MOVE 0 TO flag
             END-IF

           .
        P199.
      *0-length strings enforced in the VARCHAR test. 
      *Blanks expected here for fixed-length character string 
             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

      *Can't test much about these:  18.1 GR.3.k 

             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:  data exception -- division by zero 

             MOVE 0 TO int1
             DISPLAY "int1 = 0"
             DISPLAY "INSERT INTO HU.STAFF VALUES ("
             DISPLAY " '000', 'Loser', 1 / :int1, 'Baltimore');"
             EXEC SQL INSERT INTO HU.STAFF VALUES (
               '000', 'Loser', 1 / :int1, 'Baltimore') END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 22012; its value is ", SQLSTATE
             if (SQLSTATE  NOT  =   "22012") 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
             END-EXEC
             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 22012; its value is ", st
             if (st  NOT  =   "22012") 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

      *Intentional duplication:  condition info should not have change

             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
             END-EXEC
             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 22012; its value is ", st
             if (st  NOT  =   "22012") 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

      *Subtest 3:  column constraint violation 
      *18.1 GR.3.f 
      *Insert non-unique EMPNUM into HU.STAFF 

             DISPLAY "INSERT INTO HU.STAFF VALUES ("
             DISPLAY " 'E1', 'Bart', 10, 'Annapolis');"
             EXEC SQL INSERT INTO HU.STAFF VALUES (
               'E1', 'Bart', 10, 'Annapolis') END-EXEC
             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 23000; its value is ", SQLSTATE
           PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (NORMSQ  NOT  =   "23000") then
               MOVE 0 TO flag
             END-IF
             MOVE 0 TO odsflg
             if (NORMSQ   =   "23000"  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 "xx" TO cns
             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
             MOVE 1 TO int2
             DISPLAY "int2 = 1"
             DISPLAY "GET DIAGNOSTICS EXCEPTION :int2"
             DISPLAY " :nl5 = CURSOR_NAME, :mtxt = MESSAGE_TEXT,"
             DISPLAY " :cns = CONSTRAINT_SCHEMA, :snam = SCHEMA_NAME,"
             DISPLAY " :int1 = CONDITION_NUMBER, :st =
      -    " RETURNED_SQLSTATE,"
             DISPLAY " :co = CLASS_ORIGIN, :sco = SUBCLASS_ORIGIN,"
             DISPLAY " :tnam = TABLE_NAME, :nl4 = COLUMN_NAME,"
             DISPLAY " :mlen = MESSAGE_LENGTH, :omlen =
      -    " MESSAGE_OCTET_LENGTH;"
             EXEC SQL GET DIAGNOSTICS EXCEPTION :int2
               :nl5 = CURSOR_NAME, :mtxt = MESSAGE_TEXT,
               :cns = CONSTRAINT_SCHEMA, :snam = SCHEMA_NAME,
               :int1 = CONDITION_NUMBER, :st = RETURNED_SQLSTATE,
               :co = CLASS_ORIGIN, :sco = SUBCLASS_ORIGIN,
               :tnam = TABLE_NAME, :nl4 = COLUMN_NAME,
               :mlen = MESSAGE_LENGTH, :omlen = MESSAGE_OCTET_LENGTH
             END-EXEC
             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 P197
             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 P196
           .
        P197.
             DISPLAY "sco should NOT be 'ISO 9075 '; its value is ",
             sco
             if (sco   =   "ISO 9075 ") then
               MOVE 0 TO flag
             END-IF

           .
        P196.
             DISPLAY "cns should be 'HU'; its value is '", cns "'"
             if (cns  NOT  =   "HU") 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'; its value is '", tnam "'"
             if (tnam  NOT  =   "STAFF") 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 4:  invalid cursor state 
      *18.1 GR.3.h 

             DISPLAY "DECLARE C12721 CURSOR FOR"
             DISPLAY " SELECT EMPNUM FROM HU.WORKS;"
             EXEC SQL DECLARE C12721 CURSOR FOR
               SELECT EMPNUM FROM HU.WORKS END-EXEC
             DISPLAY  " "

             DISPLAY "CLOSE C12721;"
             EXEC SQL CLOSE C12721 END-EXEC
             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 24000; its value is ", SQLSTATE
           PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (NORMSQ  NOT  =   "24000") then
               MOVE 0 TO flag
             END-IF
             MOVE 0 TO odsflg
             if (NORMSQ   =   "24000"  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 "x" TO nl2
             MOVE "x" TO nl3
             MOVE "x" TO nl4
             MOVE "xxxxxx" TO csrnam
             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 " :csrnam = 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,
               :csrnam = CURSOR_NAME, :mtxt = MESSAGE_TEXT,
               :mlen = MESSAGE_LENGTH, :omlen = MESSAGE_OCTET_LENGTH
             END-EXEC
             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 P195
             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 P194
           .
        P195.
             DISPLAY "sco should NOT be 'ISO 9075 '; its value is ",
             sco
             if (sco   =   "ISO 9075 ") then
               MOVE 0 TO flag
             END-IF

           .
        P194.
             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 "csrnam should be 'C12721'; its value is '",
             csrnam "'"
             if (csrnam  NOT  =   "C12721") 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 5: with check option violation 
      *18.1 GR.3.i 

             DISPLAY "INSERT INTO WCOV VALUES (0);"
             EXEC SQL INSERT INTO WCOV VALUES (0) END-EXEC
             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 44000; its value is ", SQLSTATE
           PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (NORMSQ  NOT  =   "44000") then
               MOVE 0 TO flag
             END-IF
             MOVE 0 TO odsflg
             if (NORMSQ   =   "44000"  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
             END-EXEC
             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 P193
             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 P192
           .
        P193.
             DISPLAY "sco should NOT be 'ISO 9075 '; its value is ",
             sco
             if (sco   =   "ISO 9075 ") then
               MOVE 0 TO flag
             END-IF

           .
        P192.
             DISPLAY "nl1 should be ' '; its value is '", nl1 "'"
             if (nl1  NOT  =   " ") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "snam should be 'FLATER'; its value is '", snam "'"
             if (snam  NOT  =   "FLATER") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "tnam should be 'WCOV '; its value is '", tnam "'"
             if (tnam  NOT  =   "WCOV ") 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 6:  cursor operation conflict (18.1 GR.3.e) 

             DISPLAY "DECLARE C12722 CURSOR FOR"
             DISPLAY " SELECT GRADE FROM HU.STAFF;"
             EXEC SQL DECLARE C12722 CURSOR FOR
               SELECT GRADE FROM HU.STAFF END-EXEC

             DISPLAY "OPEN C12722;"
             EXEC SQL OPEN C12722 END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             COMPUTE int1 = -1
             DISPLAY "FETCH C12722 INTO :int1;"
             EXEC SQL FETCH C12722 INTO :int1 END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "int1 is ", int1

             DISPLAY "DELETE FROM HU.STAFF WHERE CURRENT OF C12722;"
             EXEC SQL DELETE FROM HU.STAFF WHERE CURRENT OF C12722
             END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "DELETE FROM HU.STAFF;"
             EXEC SQL DELETE FROM HU.STAFF END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be >= 0 (not 100); its value is ",
             SQL-COD
             DISPLAY "SQLSTATE should be 01001; its value is ", SQLSTATE
             MOVE SQLSTATE TO olds
             if (SQLCODE  <  0  OR  SQLCODE  =  100  OR  SQLSTATE  NOT 
             =   "01001") 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 "xxxxxx" TO csrnam
             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 " :csrnam = 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,
               :csrnam = CURSOR_NAME, :mtxt = MESSAGE_TEXT,
               :mlen = MESSAGE_LENGTH, :omlen = MESSAGE_OCTET_LENGTH
             END-EXEC
             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
             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 "csrnam should be 'C12722'; its value is '",
             csrnam "'"
             if (csrnam  NOT  =   "C12722") 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 END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0666','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml127.pco *** fail *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0666','fail','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
             END-IF

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

             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
      ******************** END TEST0666 ********************
      **** 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.