Quelle xop725.cob Sprache: Cobol

       IDENTIFICATION DIVISION.
       PROGRAM-ID. XOP725.
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SOURCE-COMPUTER. xyz.
       OBJECT-COMPUTER. xyx.
       DATA DIVISION.

       WORKING-STORAGE SECTION.

      * Embedded SQL COBOL (file "XOP725.PCO")

      *   Copyright 1994, 1995 X/Open Company Limited

      *   All rights reserved.

      *   DISCLAIMER:
      *   This program was reviewed by employees of NIST for
      *   conformance to the SQL standards.
      *   NIST assumes no responsibility for any party's use of
      *   this program.

      *   X/Open and the 'X' symbol are registered trademarks of X/Open Company
      *   Limited in the UK and other countries.

      *******************************************************
      *
      *          COMMENT SECTION
      *
      * DATE 1994/O7/05 EMBEDDED COBOL LANGUAGE
      * X/Open SQL VALIDATION TEST SUITE V6.0
      *
      * XOP725.PCO
      * WRITTEN BY Susan Watters
      * Exists Only In Embedded COBOL Version
      *
      * X/O Passing SQLCA as a parameter
      * Calls program xop725s
      *
      * REFERENCES
      *    X/Open CAE SQL Specification
      *    Section 8.1.1
      *
      *         DATE LAST CHANGED  2/11/94
      *
      *******************************************************

           EXEC SQL BEGIN DECLARE SECTION END-EXEC
       01  uid PIC X(18).
       01  uidx PIC X(18).
           EXEC SQL END DECLARE SECTION END-EXEC
      *
      *SQLCA declared correctly
           EXEC SQL INCLUDE SQLCA END-EXEC.

       01  errcnt PIC S9(4) DISPLAY SIGN LEADING SEPARATE.
      *date_time declaration
       01  TO-DAY PIC 9(6).
       01  THE-TIME PIC 9(8).

       01  errflg PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
      *variable used as parameter to program xop725s
       01  answer PIC S9(4) COMP.
       01  SQL-COD PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  ANS-WER PIC S9(4) DISPLAY SIGN LEADING SEPARATE.

       PROCEDURE DIVISION.
       P0.

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

            MOVE 0 TO errcnt
           DISPLAY    "X/OPEN Extensions SQL Test Suite, V6.0, Embedded
      -            "COBOL, xop725.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
           DISPLAY " "

      ********************* BEGIN TEST0725 ************************

            DISPLAY " TEST0725 "
            DISPLAY "X/O,INCLUDE SQLCA IN LINKAGE SECTION"
            DISPLAY "Tests passing SQLCA as a parameter"
            DISPLAY " "
            DISPLAY "X/OPEN CAE Specification Section 8.1.1 "
            DISPLAY "This program should compile cleanly."
            DISPLAY "=============================================="

           EXEC SQL DELETE FROM INTS END-EXEC

           EXEC SQL COMMIT WORK END-EXEC

      *initialise table
            EXEC SQL INSERT INTO INTS VALUES (1, 1) END-EXEC
            EXEC SQL INSERT INTO INTS VALUES (2, 2) END-EXEC
            EXEC SQL INSERT INTO INTS VALUES (2, 3) END-EXEC
            EXEC SQL INSERT INTO INTS VALUES (1, 5) END-EXEC

      *initialise answer and SQLCODE
            MOVE 0 TO answer.
            MOVE 5 TO SQLCODE.

      *Tests passing of SQLCA as a parameter
            CALL "XOP725S" USING answer, SQLCA
      *The name of the called procedure can be altered if needed

            DISPLAY "answer should = 6 and SQLCODE should = '0'"
            MOVE answer TO ANS-WER
            MOVE SQLCODE TO SQL-COD
            DISPLAY "answer = " ANS-WER " SQLCODE = " SQL-COD
            IF ((answer = 6) AND (SQLCODE = 0))
              EXEC SQL INSERT INTO XOPEN1.TESTREPORT
               VALUES('0725','pass','PCO') END-EXEC
              DISPLAY " xop725.pco *** pass *** "
              DISPLAY "========================================="
           ELSE
              EXEC SQL INSERT INTO XOPEN1.TESTREPORT
               VALUES('0725','fail','PCO') END-EXEC
               COMPUTE errcnt = errcnt + 1
              DISPLAY " xop725.pco *** fail *** "
              DISPLAY "========================================="
              DISPLAY " "
            END-IF

           EXEC SQL COMMIT WORK END-EXEC

      ********************* END TEST0725 *********************

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

quality100%

¤ Dauer der Verarbeitung: 0.0 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.