SSL dml125.cob Sprache: Cobol

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

      * EMBEDDED COBOL (file "DML125.PCO")

      ****************************************************************
      *
      *                 COMMENT SECTION
      *
      * DATE 1994/6/28 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.
      *
      * DML125.PCO
      * WRITTEN BY:  David W. Flater
      * TRANSLATED AUTOMATICALLY FROM EMBEDDED C BY CHRIS SCHANZLE
      * Bug fixes & stronger pass criteria by Joan Sullivan 2/27/95
      *
      * This routine tests SQL descriptors, which is a feature of
      * Dynamic SQL.
      *
      * 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  smint1 PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
       01  smint2 PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
       01  smint3 PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
      *    OK to change the precision of bin9 to match INTEGER
       01  bin9 PIC S9(9) BINARY.
       01  int1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  int2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  int3 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  int4 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  ch1 PIC  X(1).
       01  ch7 PIC  X(7).
       01  ch13 PIC  X(13).
       01  ch17 PIC  X(17).
       01  ch32 PIC  X(32).
       01  dstmt PIC  X(50).
       01  longst PIC  X(240).
       01  word1 PIC  X(11).
       01  ch11 PIC  X(11).
       01  word2 PIC  X(30).
       01  word3 PIC  X(3).
       01  csc PIC  X(50).
       01  css PIC  X(50).
       01  csn PIC  X(50).
       01  clc PIC  X(50).
       01  cls PIC  X(50).
       01  cln PIC  X(50).
             EXEC SQL END DECLARE SECTION END-EXEC
       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, dml125.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 TEST0657 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0657 "
             DISPLAY " Descriptors: VARCHAR"
             DISPLAY "References:"
             DISPLAY " F# 1 -- Dynamic SQL"
             DISPLAY " 6.1 -- CHARACTER VARYING"
             DISPLAY " 17.1 -- Description of SQL item descriptor
      -    " areas"
             DISPLAY " 17.9 -- "
             DISPLAY " 17.10 -- "
             DISPLAY " 17.14 -- "
             DISPLAY " 17.2 GR.3 -- limit on descriptor areas is"
             DISPLAY " implementation-defined"
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             COMPUTE SQLCODE = -1
             MOVE "xxxxx" TO SQLSTATE

      *I am going to try to write this test in such a way that it will
      *work in every language, using only fixed-length host variables.

             DISPLAY "CREATE TABLE ADJECTIVES (WURD VARCHAR (30));"
             EXEC SQL CREATE TABLE ADJECTIVES (WURD VARCHAR (30))
             END-EXEC
             MOVE SQLCODE TO SQL-COD

           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "COMMIT WORK;"
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "ALLOCATE DESCRIPTOR 'D12511' WITH MAX 1;"
             EXEC SQL ALLOCATE DESCRIPTOR 'D12511' WITH MAX 1 END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             if (SQLSTATE   =   "07009")  then
               DISPLAY "Received SQLSTATE 07009 WITH MAX 1!"
               DISPLAY "This is definitely a FAIL."
             END-IF
             DISPLAY  " "

             DISPLAY "dstmt=""SELECT WURD FROM ADJECTIVES"""
             MOVE "SELECT WURD FROM ADJECTIVES "
             TO dstmt

             DISPLAY "PREPARE S12511 FROM :dstmt;"
             EXEC SQL PREPARE S12511 FROM :dstmt END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "DESCRIBE S12511 USING SQL DESCRIPTOR 'D12511';"
             EXEC SQL DESCRIBE S12511 USING SQL DESCRIPTOR 'D12511'
             END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             COMPUTE smint1 = -1
             DISPLAY "GET DESCRIPTOR 'D12511' :smint1 = COUNT;"
             EXEC SQL GET DESCRIPTOR 'D12511' :smint1 = COUNT END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "smint1 should be 1; its value is ", smint1
             if (smint1  NOT =  1) then
               MOVE 0 TO flag
             END-IF

             COMPUTE int1 = -1
             COMPUTE int2 = -1
             COMPUTE int3 = -1
             DISPLAY "GET DESCRIPTOR 'D12511' VALUE 1"
             DISPLAY " :int1 = TYPE, :int2 = LENGTH, :int3 =
      -    " OCTET_LENGTH;"
             EXEC SQL GET DESCRIPTOR 'D12511' VALUE 1
               :int1 = TYPE, :int2 = LENGTH, :int3 = OCTET_LENGTH
             END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "int1 should be 12; its value is ", int1
             DISPLAY "int2 should be 30; its value is ", int2
             DISPLAY "int3 should be > 22; its value is ", int3
             if (int1  NOT =  12  OR  int2  NOT =  30  OR  int3  NOT >
             22) then
               MOVE 0 TO flag
             END-IF

             MOVE 1 TO smint1
             MOVE 0 TO smint2
             MOVE 11 TO smint3
             DISPLAY "smint1 = 1"
             DISPLAY "smint2 = 0"
             DISPLAY "smint3 = 11"
             MOVE "Circumspect" TO ch11
             DISPLAY "SET DESCRIPTOR 'D12511' VALUE :smint1"
             DISPLAY " INDICATOR = :smint2, LENGTH = :smint3,"
             DISPLAY " TYPE = 1, DATA = :ch11;"
             EXEC SQL SET DESCRIPTOR 'D12511' VALUE :smint1
               INDICATOR = :smint2, LENGTH = :smint3,
               TYPE = 1, DATA = :ch11 END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "dstmt=""INSERT INTO ADJECTIVES VALUES (?)"""
             MOVE "INSERT INTO ADJECTIVES VALUES (?) "
             TO dstmt

             DISPLAY "PREPARE S12512 FROM :dstmt;"
             EXEC SQL PREPARE S12512 FROM :dstmt END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "EXECUTE S12512 USING SQL DESCRIPTOR 'D12511';"
             EXEC SQL EXECUTE S12512 USING SQL DESCRIPTOR 'D12511'
             END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             COMPUTE int1 = -1
             DISPLAY "SELECT COUNT(*) INTO :int1"
             DISPLAY " FROM ADJECTIVES WHERE WURD = 'Circumspect';"
             EXEC SQL SELECT COUNT(*) INTO :int1
               FROM ADJECTIVES WHERE WURD = 'Circumspect' END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "int1 should be 1; its value is ", int1
             if (int1  NOT =  1) then
               MOVE 0 TO flag
             END-IF

             DISPLAY "DESCRIBE OUTPUT S12511 USING SQL DESCRIPTOR
      -    " 'D12511';"
             EXEC SQL DESCRIBE OUTPUT S12511 USING SQL DESCRIPTOR
             'D12511' END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *parameter is CHAR, not VARCHAR
             DISPLAY "SET DESCRIPTOR 'D12511' VALUE 1"
             DISPLAY " TYPE = 1, LENGTH = 30"
             EXEC SQL SET DESCRIPTOR 'D12511' VALUE 1
               TYPE = 1, LENGTH = 30 END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "DECLARE C12511 CURSOR FOR S12511;"
             EXEC SQL DECLARE C12511 CURSOR FOR S12511 END-EXEC
             DISPLAY  " "

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

             DISPLAY "FETCH C12511 INTO SQL DESCRIPTOR 'D12511';"
             EXEC SQL FETCH C12511 INTO SQL DESCRIPTOR 'D12511' END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "CLOSE C12511;"
             EXEC SQL CLOSE C12511 END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             COMPUTE int1 = -1
             COMPUTE int3 = -1
             MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" TO word2
             DISPLAY "GET DESCRIPTOR 'D12511' VALUE 1"
             DISPLAY " :int1 = LENGTH,"
             DISPLAY " :int3 = INDICATOR, :word2 = DATA;"
             EXEC SQL GET DESCRIPTOR 'D12511' VALUE 1
               :int1 = LENGTH,
               :int3 = INDICATOR, :word2 = DATA END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "int1 should be 30; its value is ", int1
             DISPLAY "int3 should be 0; its value is ", int3
             DISPLAY "word2 should be 'Circumspect'; its value is '",
             word2 "'"
             if (int1  NOT =  30  OR  int3  NOT =  0) then
               MOVE 0 TO flag
             END-IF
             if (word2  NOT  =   "Circumspect " ) then
               MOVE 0 TO flag
             END-IF

             MOVE "Circumspect " TO ch13
             DISPLAY "SET DESCRIPTOR 'D12511' VALUE 1"
             DISPLAY " TYPE = 1, LENGTH = 13, DATA = :ch13;"
             EXEC SQL SET DESCRIPTOR 'D12511' VALUE 1
               TYPE = 1, LENGTH = 13, DATA = :ch13 END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "dstmt=""SELECT COUNT(*) FROM ADJECTIVES WHERE WURD
      -    " = ?"""
             MOVE "SELECT COUNT(*) FROM ADJECTIVES WHERE WURD
      -    " = ? " TO dstmt

             DISPLAY "PREPARE S12513 FROM :dstmt;"
             EXEC SQL PREPARE S12513 FROM :dstmt END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "DECLARE C12513 CURSOR FOR S12513;"
             EXEC SQL DECLARE C12513 CURSOR FOR S12513 END-EXEC
             DISPLAY  " "

             DISPLAY "OPEN C12513 USING SQL DESCRIPTOR 'D12511';"
             EXEC SQL OPEN C12513 USING SQL DESCRIPTOR 'D12511' END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             COMPUTE int1 = -1
             DISPLAY "FETCH C12513 INTO :int1;"
             EXEC SQL FETCH C12513 INTO :int1 END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "int1 should be 1; its value is ", int1
             if (int1  NOT =  1) then
               MOVE 0 TO flag
             END-IF

             DISPLAY "CLOSE C12513;"
             EXEC SQL CLOSE C12513 END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *SQLSTATEs for truncation (quick test)

             MOVE "semi-psychorepresentationalistic" TO ch32
             DISPLAY "SET DESCRIPTOR 'D12511' VALUE 1"
             DISPLAY " INDICATOR = 0, LENGTH = 32,"
             DISPLAY " DATA = :ch32;"
             EXEC SQL SET DESCRIPTOR 'D12511' VALUE 1
               INDICATOR = 0, LENGTH = 32,
               DATA = :ch32 END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "EXECUTE S12512 USING SQL DESCRIPTOR 'D12511';"
             EXEC SQL EXECUTE S12512 USING SQL DESCRIPTOR 'D12511'
             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
             DISPLAY "SQLSTATE should be 22001; its value is ", SQLSTATE
             if (SQLSTATE  NOT  =   "22001") then
               MOVE 0 TO flag
             END-IF

             DISPLAY "DESCRIBE OUTPUT S12511 USING SQL DESCRIPTOR
      -    " 'D12511';"
             EXEC SQL DESCRIBE OUTPUT S12511 USING SQL DESCRIPTOR
             'D12511' END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "SET DESCRIPTOR 'D12511' VALUE 1"
             DISPLAY " TYPE = 1, LENGTH = 3;"
             EXEC SQL SET DESCRIPTOR 'D12511' VALUE 1
               TYPE = 1, LENGTH = 3 END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

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

             DISPLAY "FETCH C12511 INTO SQL DESCRIPTOR 'D12511';"
             EXEC SQL FETCH C12511 INTO SQL DESCRIPTOR 'D12511' 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 01004; its value is ", SQLSTATE
             if (SQLSTATE  NOT  =   "01004") then
               MOVE 0 TO flag
             END-IF

             COMPUTE int1 = -1
             COMPUTE int3 = -1
             MOVE "xxx" TO word3
             DISPLAY "GET DESCRIPTOR 'D12511' VALUE 1"
             DISPLAY " :int1 = LENGTH,"
             DISPLAY " :int3 = INDICATOR, :word3 = DATA;"
             EXEC SQL GET DESCRIPTOR 'D12511' VALUE 1
               :int1 = LENGTH,
               :int3 = INDICATOR, :word3 = DATA END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "int1 should be 3; its value is ", int1
             DISPLAY "int3 should be 0; its value is ", int3
             DISPLAY "word3 should be 'Cir'; its value is '", word3 "'"
             if (int1  NOT =  3  OR  int3  NOT =  0  OR  word3  NOT  =
             "Cir" ) then
               MOVE 0 TO flag
             END-IF

             DISPLAY "CLOSE C12511;"
             EXEC SQL CLOSE C12511 END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "DEALLOCATE DESCRIPTOR 'D12511';"
             EXEC SQL DEALLOCATE DESCRIPTOR 'D12511' END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

           .
        P199.
             DISPLAY "ROLLBACK WORK;"
             EXEC SQL ROLLBACK WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "DROP TABLE ADJECTIVES CASCADE;"
             EXEC SQL DROP TABLE ADJECTIVES CASCADE END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "COMMIT WORK;"
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0657','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml125.pco *** fail *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0657','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 TEST0657 ********************
      ******************** BEGIN TEST0658 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0658 "
             DISPLAY " Descriptors: SQLSTATE codes"
             DISPLAY "References:"
             DISPLAY " F# 1 -- Dynamic SQL"
             DISPLAY " 22.1 -- SQLSTATE"
             DISPLAY " 17.2 GR.3"
             DISPLAY " 17.4 GR.3 GR.5"
             DISPLAY " 17.5 GR.2 GR.5"
             DISPLAY " 17.9 GR.2 GR.3.d GR.5.b GR.5.e GR.6.b"
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             COMPUTE SQLCODE = -1
             MOVE "xxxxx" TO SQLSTATE

             DISPLAY "ALLOCATE DESCRIPTOR 'D12521' WITH MAX 0;"
             EXEC SQL ALLOCATE DESCRIPTOR 'D12521' WITH MAX 0 END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 07009; its value is ", SQLSTATE
             if (SQLSTATE  NOT  =   "07009"  OR  SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF

             DISPLAY "ALLOCATE DESCRIPTOR 'D12521' WITH MAX 1;"
             EXEC SQL ALLOCATE DESCRIPTOR 'D12521' WITH MAX 1 END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             if (SQLSTATE   =   "07009")  then
               DISPLAY "Received SQLSTATE 07009 WITH MAX 1!"
               DISPLAY "This is definitely a FAIL."
             END-IF
             DISPLAY  " "

             DISPLAY "dstmt=""SELECT ZZ FROM CONCATBUF"""
             MOVE "SELECT ZZ FROM CONCATBUF "
             TO dstmt

             DISPLAY "PREPARE S12521 FROM :dstmt;"
             EXEC SQL PREPARE S12521 FROM :dstmt END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "DESCRIBE S12521 USING SQL DESCRIPTOR 'D12521';"
             EXEC SQL DESCRIBE S12521 USING SQL DESCRIPTOR 'D12521'
             END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *07009 on get descriptor value 0  17.4 GR.3

             DISPLAY "GET DESCRIPTOR 'D12521' VALUE 0"
             DISPLAY " :int1 = INDICATOR;"
             EXEC SQL GET DESCRIPTOR 'D12521' VALUE 0
               :int1 = INDICATOR END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 07009; its value is ", SQLSTATE
             if (SQLSTATE  NOT  =   "07009"  OR  SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF

      *07009 on set descriptor value 0  17.5 GR.2

             MOVE 0 TO int1
             DISPLAY "int1 = 0"
             DISPLAY "SET DESCRIPTOR 'D12521' VALUE :int1"
             DISPLAY " INDICATOR = 0;"
             EXEC SQL SET DESCRIPTOR 'D12521' VALUE :int1
               INDICATOR = 0 END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 07009; its value is ", SQLSTATE
             if (SQLSTATE  NOT  =   "07009"  OR  SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF

      *33000 on using nonexistent descriptor 17.9 GR.2

             DISPLAY "dstmt=""INSERT INTO CONCATBUF VALUES (?)"""
             MOVE "INSERT INTO CONCATBUF VALUES (?) "
             TO dstmt

             DISPLAY "PREPARE S12522 FROM :dstmt;"
             EXEC SQL PREPARE S12522 FROM :dstmt END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "EXECUTE S12522 USING SQL DESCRIPTOR 'BOB';"
             EXEC SQL EXECUTE S12522 USING SQL DESCRIPTOR 'BOB' END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 33000; its value is ", SQLSTATE
             if (SQLSTATE  NOT  =   "33000"  OR  SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF

      *01005 on describe table with too many columns 17.9 GR.3.d

             DISPLAY "dstmt=""SELECT * FROM HU.WORKS"""
             MOVE "SELECT * FROM HU.WORKS
      -    " " TO dstmt

             DISPLAY "PREPARE S12523 FROM :dstmt;"
             EXEC SQL PREPARE S12523 FROM :dstmt END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "DESCRIBE S12523 USING SQL DESCRIPTOR 'D12521';"
             EXEC SQL DESCRIBE S12523 USING SQL DESCRIPTOR 'D12521'
             END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be >= 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 01005; its value is ", SQLSTATE
             if (SQLSTATE  NOT  =   "01005"  OR  SQLCODE  <  0) then
               MOVE 0 TO flag
             END-IF

      *COUNT should have been set.

             COMPUTE int1 = -1
             DISPLAY "GET DESCRIPTOR 'D12521' :int1 = COUNT;"
             EXEC SQL GET DESCRIPTOR 'D12521' :int1 = COUNT END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY "int1 should be 3; its value is ", int1
             if (int1  NOT =  3) then
               MOVE 0 TO flag
             END-IF

      *07008 on using descriptor with COUNT too big 17.9 GR.5.b.ii

             DISPLAY "EXECUTE S12522 USING SQL DESCRIPTOR 'D12521';"
             EXEC SQL EXECUTE S12522 USING SQL DESCRIPTOR 'D12521'
             END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 07008; its value is ", SQLSTATE
             if (SQLSTATE  NOT  =   "07008"  OR  SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF

      *07001 on using descriptor with invalid values 17.9 GR.5.b.iii

             DISPLAY "DESCRIBE S12521 USING SQL DESCRIPTOR 'D12521';"
             EXEC SQL DESCRIBE S12521 USING SQL DESCRIPTOR 'D12521'
             END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *17.5 GR.7:  We're up against implementor-defined restrictions h
      *6.1 SR.3:  Length of 0 is invalid for any data type

             DISPLAY "SET DESCRIPTOR 'D12521' VALUE 1"
             DISPLAY " LENGTH = 0;"
             EXEC SQL SET DESCRIPTOR 'D12521' VALUE 1
               LENGTH = 0 END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  <  0) then
               DISPLAY "Violated an implementor-defined restriction --
      -    " this"
               DISPLAY "subtest will be skipped"
               GO TO P100
             END-IF
             DISPLAY "SQLCODE should be 0; its value is ", SQL-COD
             if (SQLCODE  =  100) then
               MOVE 0 TO flag
             END-IF

             DISPLAY "EXECUTE S12522 USING SQL DESCRIPTOR 'D12521';"
             EXEC SQL EXECUTE S12522 USING SQL DESCRIPTOR 'D12521'
             END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 07001; its value is ", SQLSTATE
             if (SQLSTATE  NOT  =   "07001"  OR  SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF

           .
        P100.
      *Generate an exception via 17.9 GR.5.f

             DISPLAY "dstmt=""INSERT INTO BASE_WCOV VALUES (?)"""
             MOVE "INSERT INTO BASE_WCOV VALUES (?) "
             TO dstmt

             DISPLAY "PREPARE S12524 FROM :dstmt;"
             EXEC SQL PREPARE S12524 FROM :dstmt END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "SET DESCRIPTOR 'D12521' COUNT = 1;"
             EXEC SQL SET DESCRIPTOR 'D12521' COUNT = 1 END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

      *Length defaults to 1:  17.5 GR.5.a

             MOVE "Z" TO ch1
             DISPLAY "SET DESCRIPTOR 'D12521' VALUE 1"
             DISPLAY " TYPE = 1, DATA = :ch1;"
             EXEC SQL SET DESCRIPTOR 'D12521' VALUE 1
               TYPE = 1, DATA = :ch1 END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "EXECUTE S12524 USING SQL DESCRIPTOR 'D12521';"
             EXEC SQL EXECUTE S12524 USING SQL DESCRIPTOR 'D12521'
             END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 22018; its value is ", SQLSTATE
             if (SQLSTATE  NOT  =   "22018"  OR  SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF

      *07006 on trying to do an invalid implicit cast 17.9 GR.5.e

             MOVE "DATE '1995-03-02'" TO ch17
             DISPLAY "SET DESCRIPTOR 'D12521' VALUE 1"
             DISPLAY " TYPE = 1, LENGTH = 17,"
             DISPLAY " DATA = :ch17;"
             EXEC SQL SET DESCRIPTOR 'D12521' VALUE 1
               TYPE = 1, LENGTH = 17,
               DATA = :ch17 END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "EXECUTE S12524 USING SQL DESCRIPTOR 'D12521';"
             EXEC SQL EXECUTE S12524 USING SQL DESCRIPTOR 'D12521'
             END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 07006; its value is ", SQLSTATE
             if (SQLSTATE  NOT  =   "07006"  OR  SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF

      *07002 on fetching into descriptor wrong count / invalid 17.9 GR

             DISPLAY "DECLARE C12523 CURSOR FOR S12523;"
             EXEC SQL DECLARE C12523 CURSOR FOR S12523 END-EXEC
             DISPLAY  " "

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

             DISPLAY "FETCH C12523 INTO SQL DESCRIPTOR 'D12521';"
             EXEC SQL FETCH C12523 INTO SQL DESCRIPTOR 'D12521' END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 07002; its value is ", SQLSTATE
             if (SQLSTATE  NOT  =   "07002"  OR  SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF

      *22002 on get data but not indicator when indicator is negative

             DISPLAY "SET DESCRIPTOR 'D12521' VALUE 1"
             DISPLAY " TYPE = 4, INDICATOR = -1;"
             EXEC SQL SET DESCRIPTOR 'D12521' VALUE 1
               TYPE = 4, INDICATOR = -1 END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "GET DESCRIPTOR 'D12521' VALUE 1"
             DISPLAY " :bin9 = DATA;"
             EXEC SQL GET DESCRIPTOR 'D12521' VALUE 1
               :bin9 = DATA END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 22002; its value is ", SQLSTATE
             if (SQLSTATE  NOT  =   "22002"  OR  SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF

      *22005 on conflicting TYPE and DATA 17.5 GR.5

             MOVE "WAA HOO" TO ch7
             DISPLAY "SET DESCRIPTOR 'D12521' VALUE 1"
             DISPLAY " TYPE = 5, DATA = :ch7;"
             EXEC SQL SET DESCRIPTOR 'D12521' VALUE 1
               TYPE = 5, DATA = :ch7 END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be < 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 22005; its value is ", SQLSTATE
             if (SQLSTATE  NOT  =   "22005"  OR  SQLCODE  NOT <  0) then
               MOVE 0 TO flag
             END-IF

           .
        P198.
             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('0658','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml125.pco *** fail *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0658','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 TEST0658 ********************
      ******************** BEGIN TEST0659 *******************
             MOVE 1 TO flag

             DISPLAY " TEST0659 "
             DISPLAY " Descriptors: TSQL orphaned features"
             DISPLAY "References:"
             DISPLAY " F# 1 -- Dynamic SQL"
             DISPLAY " 17.1 -- Description of SQL item descriptor
      -    " areas"
             DISPLAY " 17.5 GR.5.a"
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             COMPUTE SQLCODE = -1
             MOVE "xxxxx" TO SQLSTATE

             DISPLAY "ALLOCATE DESCRIPTOR 'D12531' WITH MAX 1;"
             EXEC SQL ALLOCATE DESCRIPTOR 'D12531' WITH MAX 1 END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             if (SQLSTATE   =   "07009")  then
               DISPLAY "Received SQLSTATE 07009 WITH MAX 1!"
               DISPLAY "This is definitely a FAIL."
             END-IF
             DISPLAY  " "

      *17.5 GR.5.a  TYPE=1 in SET DESCRIPTOR sets CHARACTER_* and LENG

             DISPLAY "SET DESCRIPTOR 'D12531' VALUE 1"
             DISPLAY " TYPE = 1;"
             EXEC SQL SET DESCRIPTOR 'D12531' VALUE 1
               TYPE = 1 END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             MOVE 0 TO int1
             MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
             TO csc
             MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
             TO css
             MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
             TO csn
             DISPLAY "GET DESCRIPTOR 'D12531' VALUE 1"
             DISPLAY " :csc = CHARACTER_SET_CATALOG,"
             DISPLAY " :css = CHARACTER_SET_SCHEMA,"
             DISPLAY " :csn = CHARACTER_SET_NAME,"
             DISPLAY " :int1 = LENGTH;"
             EXEC SQL GET DESCRIPTOR 'D12531' VALUE 1
               :csc = CHARACTER_SET_CATALOG,
               :css = CHARACTER_SET_SCHEMA,
               :csn = CHARACTER_SET_NAME,
               :int1 = LENGTH END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be >= 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 00xxx or 01004; its value is ",
             SQLSTATE
             DISPLAY "int1 should be 1; its value is ", int1
             if (int1  NOT =  1) then
               MOVE 0 TO flag
             END-IF
           PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE  <  0) then
               MOVE 0 TO flag
             END-IF
             if (SQLSTATE  NOT  =   "01004"  AND  NORMSQ  NOT  =
             "00000") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "csc is ", csc
             DISPLAY "css is ", css
             DISPLAY "csn is ", csn

      *17.5 GR.4.e.iv.1  TYPE = 1 in DESCRIBE sets COLLATION_* fields

             DISPLAY "dstmt=""SELECT * FROM HU.ECCO"""
             MOVE "SELECT * FROM HU.ECCO
      -    " " TO dstmt

             DISPLAY "PREPARE S12531 FROM :dstmt;"
             EXEC SQL PREPARE S12531 FROM :dstmt END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             DISPLAY "DESCRIBE S12531 USING SQL DESCRIPTOR 'D12531';"
             EXEC SQL DESCRIBE S12531 USING SQL DESCRIPTOR 'D12531'
             END-EXEC
             MOVE SQLCODE TO SQL-COD
           PERFORM CHCKOK
             DISPLAY  " "

             MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
             TO csc
             MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
             TO css
             MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
             TO csn
             MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
             TO clc
             MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
             TO cls
             MOVE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
             TO cln
             DISPLAY "GET DESCRIPTOR 'D12531' VALUE 1"
             DISPLAY " :csc = CHARACTER_SET_CATALOG,"
             DISPLAY " :css = CHARACTER_SET_SCHEMA,"
             DISPLAY " :csn = CHARACTER_SET_NAME,"
             DISPLAY " :clc = COLLATION_CATALOG,"
             DISPLAY " :cls = COLLATION_SCHEMA,"
             DISPLAY " :cln = COLLATION_NAME;"
             EXEC SQL GET DESCRIPTOR 'D12531' VALUE 1
               :csc = CHARACTER_SET_CATALOG,
               :css = CHARACTER_SET_SCHEMA,
               :csn = CHARACTER_SET_NAME,
               :clc = COLLATION_CATALOG,
               :cls = COLLATION_SCHEMA,
               :cln = COLLATION_NAME END-EXEC
             MOVE SQLCODE TO SQL-COD
             DISPLAY "SQLCODE should be >= 0; its value is ", SQL-COD
             DISPLAY "SQLSTATE should be 00xxx or 01004; its value is ",
             SQLSTATE
           PERFORM NOSUBCLASS THRU EXIT-NOSUBCLASS
             if (SQLCODE  <  0) then
               MOVE 0 TO flag
             END-IF
             if (SQLSTATE  NOT  =   "01004"  AND  NORMSQ  NOT  =
             "00000") then
               MOVE 0 TO flag
             END-IF
             DISPLAY "csc is ", csc
             DISPLAY "css is ", css
             DISPLAY "csn is ", csn
             DISPLAY "clc is ", clc
             DISPLAY "cls is ", cls
             DISPLAY "cln is ", cln

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

             if ( flag  =  1 ) then
               DISPLAY " *** pass *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0659','pass','PCO') END-EXEC
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " dml125.pco *** fail *** "
               EXEC SQL INSERT INTO HU.TESTREPORT
                 VALUES('0659','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 TEST0659 ********************
      **** 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.23Bemerkung: (vorverarbeitet) ¤

*Bot Zugriff

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.