Quelle dml055.cob Sprache: Cobol

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

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

      ****************************************************************
      *
      *                 COMMENT SECTION
      *
      * DATE 1988/02/10 STANDARD COBOL LANGUAGE
      * NIST SQL VALIDATION TEST SUITE V6.0
      *  DISCLAIMER:
      *  This program was written by employees of NIST to test SQL
      *  implementations for conformance to the SQL standards.
      *  NIST assumes no responsibility for any party's use of
      *  this program.
      *
      * DML055.SCO
      * WRITTEN BY: SUN DAJUN
      * TRANSLATED AUTOMATICALLY FROM EMBEDDED COBOL BY CHRIS SCHANZLE
      *
      *    THIS ROUTINE TESTS THE LIMIT ON THE PRECISION OF VARIOUS
      *    DATA TYPES.
      *
      * REFERENCES
      *       AMERICAN NATIONAL STANDARD database language - SQL
      *                         X3.135-1989
      *
      *       FIPS PUB 127-1, Section 13.5
      *       Sizing for database constructs
      *
      *
      ****************************************************************

      * EXEC SQL BEGIN DECLARE SECTION END-EXEC
       01  count1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  count2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  float1 PIC S9V9(15) USAGE DISPLAY SIGN LEADING SEPARATE.
       01  float2 PIC S9V9(15) USAGE IS DISPLAY SIGN LEADING SEPARATE.
      * EXEC SQL END DECLARE SECTION END-EXEC
       01  SQLCODE PIC S9(9) COMP.
       01  errcnt PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
       01  code1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  code2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  t1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  t2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  f1 PIC S9V9(15).
       01  f2 PIC S9V9(15).
       01  uid PIC  X(18).
       01  uidx PIC X(18).
       01  FLOAT-DSP PIC -9.9(15).
       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
           CALL "AUTHCK" USING SQLCODE uidx
           MOVE SQLCODE TO SQL-COD
           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, Module COBOL, dml055.sco"
           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 TEST0243 *******************

           DISPLAY " FIPS sizing TEST0243"
           DISPLAY "reference: X3.135-1989 5.5 FIPS PUB 127-1 Section
      -    " 13.5"
           DISPLAY " The precision of SMALLINT is at least 4 digits"
           DISPLAY " - - - - - - - - - - - - - - - - - - -"
           DISPLAY " *** CREATE TABLE HH (SMALLTEST SMALLINT) "
           DISPLAY " INSERT INTO HH "
           DISPLAY " VALUES(9999);"
           DISPLAY  " "
           DISPLAY " SELECT COUNT(*) INTO :count1 FROM HH"
           DISPLAY " WHERE SMALLTEST = 9999; "
           DISPLAY  " "
           DISPLAY " INSERT INTO HH "
           DISPLAY " VALUES(-9999);"
           DISPLAY  " "
           DISPLAY " SELECT SMALLTEST INTO :count2 FROM HH"
           DISPLAY " WHERE SMALLTEST = -9999; "
           DISPLAY  " "

      * EXEC SQL DELETE FROM HH;
           CALL "SUB1" USING SQLCODE
           MOVE SQLCODE TO SQL-COD
      * EXEC SQL INSERT INTO HH
      *  VALUES(9999) END-EXEC
           CALL "SUB2" USING SQLCODE
           MOVE SQLCODE TO SQL-COD
           MOVE SQLCODE TO code1
           MOVE 0 TO count1
      * EXEC SQL SELECT COUNT(*) INTO :count1 FROM HH
      *  WHERE SMALLTEST = 9999 END-EXEC
           CALL "SUB3" USING SQLCODE count1
           MOVE SQLCODE TO SQL-COD

      * EXEC SQL INSERT INTO HH
      *  VALUES(-9999) END-EXEC
           CALL "SUB4" USING SQLCODE
           MOVE SQLCODE TO SQL-COD
           MOVE SQLCODE TO code2
           MOVE 0 TO count2
      * EXEC SQL SELECT SMALLTEST INTO :count2 FROM HH
      *  WHERE SMALLTEST = -9999 END-EXEC
           CALL "SUB5" USING SQLCODE count2
           MOVE SQLCODE TO SQL-COD

           DISPLAY "The correct answer should be:"
           DISPLAY " code1 = 0, code2 = 0 "
           DISPLAY " count1 = 1,count2 = -9999"

           DISPLAY "Your answer is:"
           DISPLAY " code1 = ", code1 ",code2 = ", code2
           DISPLAY " count1 = ", count1 ",count2 = ",
             count2

      * EXEC SQL ROLLBACK WORK;
           CALL "SUB6" USING SQLCODE
           MOVE SQLCODE TO SQL-COD
           if (code1  =  0  AND  code2  =  0  AND  count1  =  1  AND
             count2  =  -9999) then
      *  EXEC SQL INSERT INTO TESTREPORT
      *    VALUES('0243','pass','MCO') END-EXEC
             CALL "SUB7" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
             DISPLAY " *** pass *** "
           else
      *  EXEC SQL INSERT INTO TESTREPORT
      *    VALUES('0243','fail','MCO') END-EXEC
             ADD 1 TO errcnt
             CALL "SUB8" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
             DISPLAY " dml055.sco *** fail *** "
           END-IF
           DISPLAY "================================================"

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

      ******************** END TEST0243 *******************

      ******************** BEGIN TEST0244 *******************

           DISPLAY " FIPS sizing TEST0244"
           DISPLAY "reference: X3.135-1989 5.5 FIPS PUB 127-1 Section
      -    " 13.5"
           DISPLAY " The precision of INTEGER is at least 9 digits"
           DISPLAY " - - - - - - - - - - - - - - - - - - -"
           DISPLAY " *** CREATE TABLE EE (INTTEST INTEGER) "
           DISPLAY " INSERT INTO EE "
           DISPLAY " VALUES(999999999);"
           DISPLAY  " "
           DISPLAY " SELECT INTTEST INTO :count1"
           DISPLAY " FROM EE"
           DISPLAY " WHERE INTTEST = 999999999;"
           DISPLAY  " "
           DISPLAY " INSERT INTO EE "
           DISPLAY " VALUES(-999999999);"
           DISPLAY  " "
           DISPLAY " SELECT COUNT(*) INTO :count2"
           DISPLAY " FROM EE"
           DISPLAY " WHERE INTTEST = -999999999;"
           DISPLAY  " "
           MOVE 0 TO count1
           MOVE 0 TO count2

      * EXEC SQL DELETE FROM EE;
           CALL "SUB10" USING SQLCODE
           MOVE SQLCODE TO SQL-COD
      * EXEC SQL INSERT INTO EE
      *  VALUES(999999999) END-EXEC
           CALL "SUB11" USING SQLCODE
           MOVE SQLCODE TO SQL-COD
           MOVE SQLCODE TO code1

      * EXEC SQL SELECT INTTEST INTO :count1
      *  FROM EE
      *  WHERE INTTEST = 999999999 END-EXEC
           CALL "SUB12" USING SQLCODE count1
           MOVE SQLCODE TO SQL-COD

      * EXEC SQL INSERT INTO EE
      *  VALUES(-999999999) END-EXEC
           CALL "SUB13" USING SQLCODE
           MOVE SQLCODE TO SQL-COD
           MOVE SQLCODE TO code2

      * EXEC SQL SELECT COUNT(*) INTO :count2
      *  FROM EE
      *  WHERE INTTEST = -999999999 END-EXEC
           CALL "SUB14" USING SQLCODE count2
           MOVE SQLCODE TO SQL-COD

           DISPLAY "The correct answer should be:"
           DISPLAY " code1 = 0, code2 = 0 "
           DISPLAY " count1 = 999999999,count2 = 1"

           DISPLAY "Your answer is:"
           DISPLAY " code1 = ", code1 ",code2 = ", code2
           DISPLAY " count1 = ", count1 ",count2 = ",
             count2

      * EXEC SQL ROLLBACK WORK;
           CALL "SUB15" USING SQLCODE
           MOVE SQLCODE TO SQL-COD
           if (code1  =  0  AND  code2  =  0  AND  count1  =  999999999
             AND  count2  =  1) then
      *  EXEC SQL INSERT INTO TESTREPORT
      *    VALUES('0244','pass','MCO') END-EXEC
             CALL "SUB16" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
             DISPLAY " *** pass *** "
           else
      *  EXEC SQL INSERT INTO TESTREPORT
      *    VALUES('0244','fail','MCO') END-EXEC
             ADD 1 TO errcnt
             CALL "SUB17" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
             DISPLAY " dml055.sco *** fail *** "
           END-IF
           DISPLAY "================================================"

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

      ******************** END TEST0244 *******************

      ******************** BEGIN TEST0245 *******************

           DISPLAY " FIPS sizing TEST0245"
           DISPLAY "reference: X3.135-1989 5.5 FIPS PUB 127-1 Section
      -    " 13.5"
           DISPLAY " The precision of DECIMAL is at least 15 digits"
           DISPLAY " - - - - - - - - - - - - - - - - - - -"

           DISPLAY " *** CREATE TABLE PP_15 (NUMTEST
      -    " DECIMAL(15,15)) "
           DISPLAY " INSERT INTO PP_15 "
           DISPLAY " VALUES(.123456789012345);"
           DISPLAY  " "
           DISPLAY " DECLARE DATA9 CURSOR"
           DISPLAY " FOR SELECT NUMTEST"
           DISPLAY " FROM PP_15;"
           DISPLAY " FETCH DATA9 INTO :float1;"
           DISPLAY " INSERT INTO PP_15 "
           DISPLAY " VALUES(-.912345678901234);"
           DISPLAY " FETCH DATA9 INTO :float2;"
           DISPLAY  " "
           DISPLAY "EXEC SQL SELECT COUNT(*) INTO :count1 FROM PP_15"
           DISPLAY " WHERE NUMTEST = -0.912345678901234;"
           DISPLAY  " "
      * EXEC SQL DELETE FROM PP_15;
           CALL "SUB19" USING SQLCODE
           MOVE SQLCODE TO SQL-COD

      * EXEC SQL INSERT INTO PP_15
      *  VALUES(.123456789012345) END-EXEC
           CALL "SUB20" USING SQLCODE
           MOVE SQLCODE TO SQL-COD

           MOVE SQLCODE TO code1

      * EXEC SQL DECLARE DATA9 CURSOR
      *  FOR SELECT NUMTEST
      *  FROM   PP_15 END-EXEC
      * EXEC SQL OPEN DATA9;
           CALL "SUB21" USING SQLCODE
           MOVE SQLCODE TO SQL-COD

      * EXEC SQL FETCH DATA9 INTO :float1;
           CALL "SUB22" USING SQLCODE float1
           MOVE SQLCODE TO SQL-COD
      * EXEC SQL CLOSE DATA9;
           CALL "SUB23" USING SQLCODE
           MOVE SQLCODE TO SQL-COD

      * EXEC SQL DELETE FROM PP_15;
           CALL "SUB24" USING SQLCODE
           MOVE SQLCODE TO SQL-COD
      * EXEC SQL INSERT INTO PP_15
      *  VALUES(-.912345678901234) END-EXEC
           CALL "SUB25" USING SQLCODE
           MOVE SQLCODE TO SQL-COD

           MOVE SQLCODE TO code2

      * EXEC SQL OPEN DATA9;
           CALL "SUB21" USING SQLCODE
           MOVE SQLCODE TO SQL-COD
      * EXEC SQL FETCH DATA9 INTO :float2;
           CALL "SUB27" USING SQLCODE float2
           MOVE SQLCODE TO SQL-COD
      * EXEC SQL CLOSE DATA9;
           CALL "SUB28" USING SQLCODE
           MOVE SQLCODE TO SQL-COD

           MOVE 0 TO count1
      * EXEC SQL SELECT COUNT(*) INTO :count1 FROM PP_15
      *  WHERE NUMTEST = -0.912345678901234 END-EXEC
           CALL "SUB29" USING SQLCODE count1
           MOVE SQLCODE TO SQL-COD

           DISPLAY "The correct answer should be:"
           DISPLAY " code1 = 0, code2 = 0 "
           DISPLAY " float1 = 0.123456789012345"
           DISPLAY " float2 = -0.912345678901234"
           DISPLAY " count1 = 1 "

           DISPLAY "Your answer is:"
           DISPLAY " code1 = ", code1 ",code2 = ", code2
           MOVE float1 TO FLOAT-DSP
           DISPLAY " float1 = ", FLOAT-DSP
           MOVE float2 TO FLOAT-DSP
           DISPLAY " float2 = ", FLOAT-DSP
           DISPLAY " count1 = ", count1

           if (float1  >  0.123456789012345) then
             COMPUTE f1 = float1 - 0.123456789012345
           else
             COMPUTE f1 = 0.123456789012345 - float1
           END-IF
           if (float2  >  -0.912345678901234) then
             COMPUTE f2 = float2 + 0.912345678901234
           else
             COMPUTE f2 = -0.912345678901234 - float2
           END-IF
           if (f1  <  0.000000000000005) then
             MOVE 0 TO t1
           else
             MOVE 1 TO t1
           END-IF
           if (f2  <  0.000000000000005) then
             MOVE 0 TO t2
           else
             MOVE 1 TO t2
           END-IF
      * EXEC SQL ROLLBACK WORK;
           CALL "SUB30" USING SQLCODE
           MOVE SQLCODE TO SQL-COD
           if (code1  =  0  AND  code2  =  0  AND  t1  =  0  AND  t2  =
             0  AND  count1  = 1) then
      *  EXEC SQL INSERT INTO TESTREPORT
      *    VALUES('0245','pass','MCO') END-EXEC
             CALL "SUB31" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
             DISPLAY " *** pass *** "
           else
      *  EXEC SQL INSERT INTO TESTREPORT
      *    VALUES('0245','fail','MCO') END-EXEC
             ADD 1 TO errcnt
             CALL "SUB32" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
             DISPLAY " dml055.sco *** fail *** "
           END-IF
           DISPLAY "================================================"

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

      ******************** END TEST0245 *******************

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

      *    ****  Procedures for PERFORM statements

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