Quelle  cob009.cob   Sprache: Cobol

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

      * EMBEDDED COBOL (file "COB009.PCO")

      ***************************************************************
      *                                                              
      *                 COMMENT SECTION                              
      *                                                              
      * DATE 1989/11/09 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.
      *                                                              
      * COB009.PCO   
      * WRITTEN BY: S Hurwitz
      *                                                    
      *    THIS PROGRAM TESTS SQL INTERSPERSED WITH
      *         COBOL NESTED IF STATEMENTS, ON SIZE ERROR,
      *         NOT ON SIZE ERROR, LABEL ON SAME LINE WITH EXEC SQL, 
      *         AND VALUE IS CLAUSE
      *                                                              
      * REFERENCES                                                   
      *       AMERICAN NATIONAL STANDARD database language - SQL     
      *                         X3.168-1989                           
      *          
      *             9.5 <embedded SQL COBOL program>
      *     
      *                                                               
      ***************************************************************

           EXEC SQL BEGIN DECLARE SECTION END-EXEC
       77  HOURS1 PIC IS S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  EMPNO1 PIC IS X(3) VALUE SPACES.
       01  INTTST1 PICTURE IS S9 DISPLAY SIGN LEADING SEPARATE.
       01  J5 PIC S9(9) USAGE DISPLAY SIGN LEADING SEPARATE.
       01  J6 PIC S9(3) USAGE IS DISPLAY SIGN LEADING SEPARATE.
       01  V1 PICTURE IS XXX VALUE IS "SMH".
       01  V2 PICTURE S9 DISPLAY SIGN LEADING SEPARATE VALUE IS 5.
       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  I1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  J2 PIC S9(2) DISPLAY SIGN LEADING SEPARATE.
       01  I3 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  I4 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  X PIC X VALUE IS "X".


       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, cob009.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 TEST0292 *******************

           DISPLAY  " TEST0292 "
           DISPLAY  "reference: X3.168-1989, 9.5 SR 4b) "
           DISPLAY
             "- - - - - - - - - - - - - - - - - - - - - - - - - - -"
           DISPLAY " "

           EXEC SQL DELETE FROM EE END-EXEC
           EXEC SQL DELETE FROM TEMP_S END-EXEC
           EXEC SQL INSERT INTO TEMP_S
             VALUES ('SMH',-55,'NA') END-EXEC
           EXEC SQL INSERT INTO EE
             VALUES (:V2) END-EXEC
           EXEC SQL SELECT INTTEST
             INTO :INTTST1 FROM EE
             WHERE INTTEST = 5 END-EXEC
           EXEC SQL SELECT EMPNUM 
             INTO :EMPNO1 FROM TEMP_S
             WHERE EMPNUM = :V1 END-EXEC
           DISPLAY " EMPNO1 should be SMH and INTTST1 = 5 "

           DISPLAY " EMPNO1 = " EMPNO1
           DISPLAY " INTTST1 = " INTTST1

           EXEC SQL ROLLBACK WORK END-EXEC

           if ( EMPNO1 = "SMH" AND INTTST1 = 5 ) then
   
           DISPLAY " "
           DISPLAY  " *** pass ***"
           EXEC SQL INSERT INTO TESTREPORT
           VALUES('0292','pass','PCO') END-EXEC
           MOVE SQLCODE TO SQL-COD

           else 

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

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

           EXEC SQL COMMIT WORK END-EXEC
      
      ********************* END TEST0292 ********************     
 
      ******************** BEGIN TEST0293 *******************

           DISPLAY  " TEST0293"
           DISPLAY  "reference: X3.168-1989, 9.5 SR 2) "
           DISPLAY 
             "- - - - - - - - - - - - - - - - - - - - - - - - - - -"

           DISPLAY " "

           EXEC SQL DELETE FROM FF END-EXEC
           EXEC SQL DELETE FROM EE END-EXEC
           EXEC SQL INSERT INTO EE VALUES (1) END-EXEC

           MOVE 0 TO I1
           MOVE 0 TO J2
           MOVE 0 TO I3
           MOVE 0 TO I4
           MOVE 0 TO J5

           IF I1 = 0
              IF J2 = 0
                 IF I3 = 0
                    EXEC SQL SELECT HOURS INTO :HOURS1
                         FROM WORKS 
                         WHERE EMPNUM = 'E3' END-EXEC
           .

           DIVIDE I1 INTO HOURS1 GIVING I4 
                  ON SIZE ERROR
                  EXEC SQL INSERT INTO FF
                       VALUES (9) END-EXEC.
           IF ( X = "X" ) GO TO P110.
           DISPLAY " This should not be displayed! ".

       P110.  EXEC SQL SELECT INTTEST INTO :J5
                FROM FF END-EXEC
           ADD J5 TO J2 GIVING J2 
               NOT ON SIZE ERROR
               EXEC SQL DELETE FROM EE END-EXEC
               EXEC SQL INSERT INTO EE
                    VALUES (4) END-EXEC
           END-ADD
           EXEC SQL SELECT INTTEST INTO :J6
                FROM EE END-EXEC

           DISPLAY " The correct answer is: J5 = 9, J2 = 9, J6 = 4 "
           DISPLAY " and HOURS1 = 20 "
           DISPLAY " Your answer is: J5 = " J5 
           DISPLAY " J2 = " J2
           DISPLAY " J6 = " J6
           DISPLAY " HOURS1 = " HOURS1
           IF ( X = "X" ) GO TO P100.
           DISPLAY " SURPRISE! THIS STATEMENT SHOULD NOT EXECUTE ".
       P100.  EXEC SQL ROLLBACK WORK END-EXEC

           if ( J5 = 9  and J2 = 9 and J6 = 4  and HOURS1 = 20) then
   
           DISPLAY " "
           DISPLAY  " *** pass ***"
           EXEC SQL INSERT INTO TESTREPORT
           VALUES('0293','pass','PCO') END-EXEC
           MOVE SQLCODE TO SQL-COD

           else 

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

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

           EXEC SQL COMMIT WORK END-EXEC

      ******************** END TEST0293 *******************

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