SSL cob008.cob Sprache: Cobol

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

      * EMBEDDED COBOL (file "COB008.PCO")

      ***************************************************************
      *
      *                 COMMENT SECTION
      *
      * DATE 1989/01/16 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.
      *
      * COB008.PCO
      * WRITTEN BY: S Hurwitz
      *
      *    THIS ROUTINE TESTS COBOL DATA TYPES IN SQL LANGUAGE.
      *
      * REFERENCES
      *       AMERICAN NATIONAL STANDARD database language - SQL
      *                         X3.135-1989
      *
      *             SECTION 5.5 <data type>
      *             ANNEX C. <embedded SQL COBOL program>
      *
      *
      ***************************************************************

           EXEC SQL BEGIN DECLARE SECTION END-EXEC
       01  var1 PIC S9(5)V99 DISPLAY SIGN LEADING SEPARATE.
       01  var2 PIC S99V DISPLAY SIGN LEADING SEPARATE.
       01  var3 PIC S99999V DISPLAY SIGN LEADING SEPARATE.
       01  var4 PIC S9(6)V9(3) DISPLAY SIGN LEADING SEPARATE.
       01  var5 PIC S9(5)V9(3) DISPLAY SIGN LEADING SEPARATE.
       01  var6 PIC SV99 DISPLAY SIGN LEADING SEPARATE.
       01  uid PIC X(18).
       01  uidx PIC X(18).
           EXEC SQL END DECLARE SECTION END-EXEC
       01  SQLCODE PIC S9(9) COMP.
       01  errcnt PIC S9(4) DISPLAY SIGN LEADING SEPARATE.

       01  ed-var1  PIC 99999.99.
       01  ed-var2  PIC 99.
       01  ed-var3  PIC 99999.
       01  ed-var4  PIC 999999.999.
       01  ed-var5  PIC 99999.999.
       01  ed-var6  PIC .99.

       01  cnt PIC 9.
       01  SQL-COD PIC S9(9) DISPLAY SIGN LEADING SEPARATE.

      * date_time declaration *
       01  TO-DAY PIC 9(6).
       01  THE-TIME PIC 9(8).

       PROCEDURE DIVISION.
       P0.

           MOVE "HU" TO uid
           CALL "AUTHID" USING uid
           MOVE "not logged in, not" TO uidx
           EXEC SQL SELECT
                 USER INTO :uidx FROM HU.ECCO END-EXEC
           if (uid NOT = uidx) then
             DISPLAY "ERROR: User " uid " expected."
             DISPLAY "User " uidx " connected."
             DISPLAY " "
             STOP RUN
           END-IF

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

      ******************** BEGIN TEST0235 *******************

           DISPLAY  " TEST0235"
           DISPLAY  "reference: X3.135-1989 5.5 & ANNEX C. "
           DISPLAY
             "- - - - - - - - - - - - - - - - - - - - - - - - - - -"

           DISPLAY " "
           DISPLAY  "*** CREATE TABLE SV (numtest NUMERIC (8,3)) "
           DISPLAY  "*** INSERT INTO SV "
           DISPLAY  "*** VALUES(12345.678) "

           MOVE 0 TO cnt

           EXEC SQL DELETE FROM SV END-EXEC
           EXEC SQL INSERT INTO SV
                 VALUES(12345.678) END-EXEC

           MOVE SQLCODE TO SQL-COD
           DISPLAY  "After INSERT SQLCODE = ", SQL-COD

           DISPLAY " "
           MOVE 0 TO var1
           EXEC SQL SELECT *
                 INTO   :var1
                 FROM   SV END-EXEC
           MOVE SQLCODE TO SQL-COD
           DISPLAY "After SELECT into var1 the SQLCODE = ", SQL-COD
           DISPLAY "*** to check exact numeric type S9(5)V99 ***"
           DISPLAY
            "*** var1 answer should be either 12345.67 or 12345.68 ***"
           MOVE var1 TO ed-var1
           DISPLAY  " var1 = ", ed-var1
           if (var1 = 12345.67 or var1 = 12345.68) ADD 1 TO cnt END-IF

           DISPLAY " "
           MOVE 0  TO var3
           EXEC SQL SELECT *
                INTO   :var3
                FROM   SV END-EXEC
           MOVE SQLCODE TO SQL-COD
           DISPLAY "After SELECT into var3 the SQLCODE = ", SQL-COD
           DISPLAY "*** to check exact numeric type S99999V ***"
           DISPLAY
            "*** var3 answer should be either 12345 or 12346 ***"
           MOVE var3 TO ed-var3
           DISPLAY " var3 = ", ed-var3
           if ((var3 = 12345) or (var3 = 12346)) ADD 1 TO cnt END-IF

           DISPLAY " "
           MOVE 0 TO var4
           EXEC SQL SELECT *
                INTO   :var4
                FROM   SV END-EXEC
           MOVE SQLCODE TO SQL-COD
           DISPLAY "After SELECT into var4 the SQLCODE = ", SQL-COD
           DISPLAY "*** to check exact numeric type S9(6)V9(3) ***"
           DISPLAY "*** var4 answer should be 12345.678 ***"
           MOVE var4 TO ed-var4
           DISPLAY " var4 = ", ed-var4
           if (var4 = 12345.678) ADD 1 TO cnt END-IF

           DISPLAY " "
           MOVE 0 TO var5
           EXEC SQL SELECT *
                INTO   :var5
                FROM   SV END-EXEC
           MOVE SQLCODE TO SQL-COD
           DISPLAY "After SELECT into var5 the SQLCODE = ", SQL-COD
           DISPLAY "*** to check exact numeric type S9(5)V9(3) ***"
           DISPLAY "*** var5 answer should be 12345.678 ***"
           MOVE var5 TO ed-var5
           DISPLAY " var5 = ", ed-var5
           if (var5 = 12345.678) ADD 1 TO cnt END-IF

           EXEC SQL ROLLBACK WORK END-EXEC

           if ( cnt = 4 ) then

           DISPLAY " "
           DISPLAY  " *** pass ***"
           EXEC SQL INSERT INTO TESTREPORT
           VALUES('0235','pass','PCO') END-EXEC
           MOVE SQLCODE TO SQL-COD

           else

           DISPLAY  " cob008.pco *** fail ***"
           EXEC SQL INSERT INTO TESTREPORT
                VALUES('0235','fail','PCO') END-EXEC
             ADD 1 TO errcnt
           MOVE SQLCODE TO SQL-COD
           END-IF

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

           EXEC SQL COMMIT WORK END-EXEC

      ******************** END TEST0235 *******************
      ******************** BEGIN TEST0236 *******************

           DISPLAY  " TEST0236"
           DISPLAY  "reference: X3.135-1989 5.5 & ANNEX C. "
           DISPLAY  "reference: X3.135-1989 8.10 GR 9) d) exact numeric"
           DISPLAY  "reference: X3.135-1989 3.3 Conventions "
           DISPLAY  "reference: X3.135-1989 4.10.1 SQLCODE parameter "
           DISPLAY " "
           DISPLAY
              "- - - - - - - - - - - - - - - - - - - - - - - - - - -"

           MOVE 0 TO  cnt

           EXEC SQL DELETE FROM SV END-EXEC
           EXEC SQL INSERT INTO SV
                 VALUES(12345.678) END-EXEC

           MOVE SQLCODE TO SQL-COD
           DISPLAY  "After INSERT SQLCODE = ", SQL-COD

           DISPLAY " "
           MOVE 0 TO var2
           EXEC SQL SELECT *
                INTO   :var2
                FROM   SV END-EXEC
           MOVE SQLCODE TO SQL-COD
           DISPLAY "After SELECT into var2, the SQLCODE = ", SQL-COD
           DISPLAY
            "*** checks SELECT into exact numeric type S99V ***"
           DISPLAY
            "*** from type S9(5)V9(3) ***"
           DISPLAY
            "The answer should be a NEGATIVE SQLCODE- - -EXCEPTION!! "
           MOVE var2 TO ed-var2
           DISPLAY " var2 = ", ed-var2
           if (SQLCODE < 0 ) ADD 1 TO cnt END-IF

           DISPLAY " "
           MOVE 0 TO var6
           EXEC SQL SELECT *
                INTO   :var6
                FROM   SV END-EXEC
           MOVE SQLCODE TO SQL-COD
           DISPLAY "After SELECT into var6, the SQLCODE = ", SQL-COD
           DISPLAY
            "*** checks SELECT into exact numeric type SV99 ***"
           DISPLAY
            "*** from type S9(5)V9(3) ***"
           DISPLAY
            "The answer should be a NEGATIVE SQLCODE- - -EXCEPTION!! "
           MOVE var6 TO ed-var6
           DISPLAY " var6 = ", ed-var6
           if (SQLCODE < 0 ) ADD 1 TO cnt END-IF

           EXEC SQL ROLLBACK WORK END-EXEC

           if ( cnt = 2 ) then

           DISPLAY " "
           DISPLAY  " *** pass ***"
           EXEC SQL INSERT INTO TESTREPORT
                VALUES('0236','pass','PCO') END-EXEC
           MOVE SQLCODE TO SQL-COD

           else

           DISPLAY  " cob008.pco *** fail ***"
           EXEC SQL INSERT INTO TESTREPORT
                VALUES('0236','fail','PCO') END-EXEC
             ADD 1 TO errcnt
           MOVE SQLCODE TO SQL-COD
           END-IF

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

           DISPLAY  " "

           EXEC SQL COMMIT WORK END-EXEC

      ******************** END TEST0236 *******************

      **** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0
           STOP RUN.

quality100%

¤ 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.0.15Bemerkung: (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.