Quelle cdr028.cob Sprache: Cobol

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

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

      ****************************************************************
      *
      *                 COMMENT SECTION
      *
      * DATE 1992/07/02 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.
      *
      * CDR028.SCO
      * WRITTEN BY: DAVID W. FLATER
      *
      *   THIS ROUTINE TESTS REFERENTIAL INTEGRITY.
      *
      ****************************************************************

      * EXEC SQL BEGIN DECLARE SECTION END-EXEC
       01  count1 PIC S9(9) 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(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  ii PIC S9(9) DISPLAY SIGN LEADING SEPARATE.

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

       PROCEDURE DIVISION.
       P0.

             MOVE "SCHANZLE" TO uid
             CALL "AUTHID" USING uid
             MOVE "not logged in, not" TO uidx
      *  EXEC SQL SELECT USER INTO :uidx FROM SUN.ECCO;
             CALL "SUB1" USING SQLCODE uidx
             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, Standard COBOL, cdr028.sco"
           DISPLAY
           "59-byte ID"
             DISPLAY "TEd Version #"
      *date_time print
           ACCEPT TO-DAY FROM DATE
           ACCEPT THE-TIME FROM TIME
           DISPLAY "Date run YYMMDD: " TO-DAY " at hhmmssff: " THE-TIME

      ******************** BEGIN TEST0486 *******************
             MOVE 1 TO flag
             DISPLAY " TEST0486 "
             DISPLAY " Priv.violation: illegal REFERENCES"
             DISPLAY "Reference ANSI SQL-1992 11.36 "
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

      *This table should be OK (albeit probably empty)
             DISPLAY "SELECT COUNT(*) INTO :count1 FROM RASTER;"
      *  EXEC SQL SELECT COUNT(*) INTO :count1 FROM RASTER;
             CALL "SUB2" USING SQLCODE count1
             MOVE SQLCODE TO SQL-COD
             MOVE SQLCODE TO ii
             DISPLAY "SQLCODE should be 0; its value is ", ii

             if (ii  NOT =  0) then
               MOVE 0 TO flag
             END-IF

      *Either this table should not be here, or it should be
      *here without the illegal constraints, in which case
      *there should have been appropriate errors and warnings
      *when the schema was loaded.

      *Is the table even here?
             DISPLAY  " "
             DISPLAY "SELECT COUNT(*) FROM REFRESH;"
             DISPLAY " (ii=SQLCODE)"
      *  EXEC SQL SELECT COUNT(*) INTO :count1 FROM REFRESH;
             CALL "SUB3" USING SQLCODE count1
             MOVE SQLCODE TO SQL-COD
             MOVE SQLCODE TO ii

             DISPLAY "INSERT INTO REFRESH VALUES ('cabbage');"
      *  EXEC SQL INSERT INTO REFRESH
      *    VALUES ('cabbage');
             CALL "SUB4" USING SQLCODE
             MOVE SQLCODE TO SQL-COD

             DISPLAY "ii and SQLCODE should either both be < 0 or both
      -    " be 0"
             DISPLAY "ii = ", ii "; SQLCODE = ", SQL-COD

             if (ii  =  0  AND  SQLCODE  NOT =  0) then
               MOVE 0 TO flag
             END-IF
             if (ii  NOT =  0  AND  SQLCODE  =  0) then
               MOVE 0 TO flag
             END-IF
             if (ii  >  0  OR  SQLCODE  >  0) then
               MOVE 0 TO flag
             END-IF

      *  EXEC SQL ROLLBACK WORK;
             CALL "SUB5" USING SQLCODE
             MOVE SQLCODE TO SQL-COD

             if (flag  =  1) then
               DISPLAY " *** pass *** "
      *    EXEC SQL INSERT INTO SUN.TESTREPORT
      *      VALUES('0486','pass','MCO');
               CALL "SUB6" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY " cdr028.sco *** fail *** "
      *    EXEC SQL INSERT INTO SUN.TESTREPORT
      *      VALUES('0486','fail','MCO');
               CALL "SUB7" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
             END-IF
      *  EXEC SQL COMMIT WORK;
             CALL "SUB8" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
             DISPLAY "================================================"

      ******************** END TEST0486 ********************

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

      *    ****  Procedures for PERFORM statements

quality100%

¤ Dauer der Verarbeitung: 0.11 Sekunden (vorverarbeitet) ¤

Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.

Bemerkung:

Die farbliche Syntaxdarstellung ist noch experimentell.