Quelle  mpa005.cob   Sprache: Cobol

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


      * Embedded SQL COBOL ("MPA005.PCO") translated from
      * Embedded COBOL on Thu Nov  7 11:40:28 1991.

      * EMBEDDED COBOL (file "MPA005.PCO")  

      ****************************************************************
      *                                                              
      *                 COMMENT SECTION                              
      *                                                              
      * DATE Halloween 1991 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.
      *                                                              
      * MPA005.PCO                                                    
      * WRITTEN BY: J Sullivan                                       
      *                                                              
      * THIS PROGRAM IS PART A OF A TWO-PART PROGRAM(A & B) THAT     
      * TESTS THE CONCURRENCY OF SQL - Phantom Read                  
      *                                                              
      * REFERENCES                                                   
      *       AMERICAN NATIONAL STANDARD database language - SQL     
      *                         X3.135-1989                          
      *                                                              
      *          SECTION  4.16 Transactions                          
      *                   Paragraph Two                              
      ****************************************************************




           EXEC SQL BEGIN DECLARE SECTION END-EXEC
       01  getct PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  seqno PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  uid PIC  X(18).
       01  uidx PIC  X(18).
       01  CC PIC  X(2).
       01  del1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  del2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
             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  mpbtot PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  ii PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  iii PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  maxseq PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  batchk PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  code1 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.

       01  pauze PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  pauze2 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  pauze3 PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  tranct PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  batchz PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  mpbins PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  testyp PIC S9(9) DISPLAY SIGN LEADING SEPARATE.


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

       PROCEDURE DIVISION.
       P0.


             MOVE "SULLIVAN1" TO uid
             CALL "AUTHID" USING uid
             MOVE "not logged in, not" TO uidx
             EXEC SQL SELECT USER INTO :uidx FROM HU.ECCO END-EXEC
             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, Embedded COBOL, mpa005.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

      *how many test suite type MPB005s are being run? 
             MOVE 1 TO testyp
      *transactions are inserted in multiples of the value of tranct 
             MOVE 5 TO tranct
      *how much to pause betwee inserts 
             MOVE 4 TO pauze3
      *this many multiples (> 2) are inserted before deleting multiple
             MOVE 5 TO batchz
      *MPA005 will look for how many inserts from each test suite type
             MOVE 24 TO mpbins

      *therefore, MPA005 will quit when count(*) from MP5_TT = mpbtot 
      *and        MPA005 will restart seqno when it exceeds maxseq 
             COMPUTE mpbtot = testyp * mpbins
             COMPUTE maxseq = tranct * batchz

      *concurrency tuning variables follow: 
      *wait pauze units after inserting a batch 
      *table MP5_TT is checked for completion every pauze2 batches 
             MOVE 1 TO pauze
             MOVE 20 TO pauze2

             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
      ******************** BEGIN TEST0457 *******************

             DISPLAY " TEST0457 "
             DISPLAY " Reference X3.135-1989 Section 4.16 Transactions
      -    " "
             DISPLAY " Paragraph Two - Serializability
      -    " "
             DISPLAY " Phantom Read"
             DISPLAY " - - - - - - - - - - - - - - - - - - -"

             DISPLAY " *** This program is part A of a two-part
      -    " "
             DISPLAY " *** program (A & B) that tests for the
      -    " concurrency "
             DISPLAY " *** of SQL. Program A inserts and deletes
      -    " multiples "
             DISPLAY " *** of 5 rows between COMMITs while Program B
      -    " reads. "
             DISPLAY " *** MPA005 loops until all MPB005s complete."

      *                      -----Initialization----- 

           .
        P100.
             MOVE 0 TO batchk
             MOVE 1 TO seqno
             MOVE 0 TO code1
             EXEC SQL DELETE FROM MP5_AA END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  <  0) then
               MOVE 1 TO code1
             END-IF
             EXEC SQL DELETE FROM MP5_AA_INDEX END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  <  0) then
               MOVE 1 TO code1
             END-IF
             EXEC SQL DELETE FROM MP5_TT END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  <  0) then
               MOVE 1 TO code1
             END-IF
             DISPLAY "MPA005: STOP if deadlock has occurred."
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  <  0) then
               MOVE 1 TO code1
             END-IF
             if (code1  =  0) then
               GO TO P110
             END-IF
             DISPLAY "MPA005: Problem initializing tables"
             EXEC SQL ROLLBACK WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
             GO TO P100

      *          -----Concurrent Transaction Loop----- 
           .
        P110.
      *          -----Delete a Batch 
      *seqno modulus maxseq 
             if (seqno  >  maxseq) then
               COMPUTE seqno = seqno - maxseq
             END-IF

      *delete a batch, a batch ahead 
             COMPUTE del1 = seqno + tranct
             if (del1  >  maxseq) then
               COMPUTE del1 = del1 - maxseq
             END-IF
             COMPUTE del2 = del1 + tranct - 1.

       P111.
             MOVE 0 TO code1
             EXEC SQL DELETE FROM MP5_AA
               WHERE ANUM BETWEEN :del1 AND :del2 END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  <  0) then
               MOVE 1 TO code1
             END-IF
             EXEC SQL DELETE FROM MP5_AA_INDEX
               WHERE ANUM BETWEEN :del1 AND :del2 END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  <  0) then
               MOVE 1 TO code1
             END-IF
             if code1 = 0 then
               EXEC SQL COMMIT WORK END-EXEC
             END-IF
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  <  0) then
               MOVE 1 TO code1
             END-IF
             if (code1  =  1) then
               DISPLAY "MPA005: Problems deleting from MP5_AA tables"
               EXEC SQL ROLLBACK WORK END-EXEC
               GO TO P111
             END-IF

           .
        P115.
      *          -----Insert a Batch 
             MOVE 0 TO ii
             MOVE 0 TO code1

           .
        P120.
             if (code1  NOT =  0) then
               GO TO P125
             END-IF
             EXEC SQL INSERT INTO MP5_AA VALUES (:seqno) END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  NOT =  0) then
               MOVE 1 TO code1
             END-IF
             EXEC SQL INSERT INTO MP5_AA_INDEX VALUES (:seqno) END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  NOT =  0) then
               MOVE 1 TO code1
             END-IF
             MOVE 0 TO iii

      *pause a little 
           .
        P121.
             EXEC SQL SELECT C1 INTO :CC FROM HU.ECCO END-EXEC
             MOVE SQLCODE TO SQL-COD
             COMPUTE iii = iii + 1
             if (iii  <  pauze3) then
               GO TO P121
             END-IF
      *end of pause 

           .
        P125.
             COMPUTE seqno = seqno + 1
             COMPUTE ii = ii + 1
             if (ii  <  tranct) then
               GO TO P120
             END-IF
             if (code1  NOT =  0) then
               EXEC SQL ROLLBACK WORK END-EXEC
               MOVE SQLCODE TO SQL-COD
               DISPLAY "MPA005: ROLLBACK due to nonzero SQLCODE
      -    " (Deadlock?)"
               GO TO P115
             END-IF
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  NOT =  0) then
               DISPLAY "MPA005: Cannot commit batch of INSERTs"
               EXEC SQL ROLLBACK WORK END-EXEC
               MOVE SQLCODE TO SQL-COD
               GO TO P115
             END-IF

      *pause a little 
             MOVE 0 TO ii
           .
        P130.
             EXEC SQL SELECT C1 INTO :CC FROM HU.ECCO END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
             COMPUTE ii = ii + 1
             if (ii  <  pauze) then
               GO TO P130
             END-IF
      *end of pause 

      *                -----Check for Completion----- 

      *check for completion only after pauze2 times 
             COMPUTE batchk = batchk + 1
             if (batchk  <  pauze2) then
               GO TO P110
             END-IF
             MOVE 0 TO batchk

      *check for completion 
             MOVE 0 TO getct
             EXEC SQL SELECT COUNT(*) INTO :getct
               FROM MP5_TT END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  NOT =  0) then
               MOVE 0 TO getct
             END-IF
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (getct  <  mpbtot) then
               GO TO P110
             END-IF

      *                          -----Evaluation----- 
             EXEC SQL SELECT COUNT(DISTINCT TESTTYPE) 
               INTO :getct FROM MP5_TT END-EXEC
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  =  0  AND  getct  <  testyp) then
               DISPLAY "MPA005: Test suite types are missing from
      -    " MP5_TT"
               COMPUTE errcnt = errcnt + 1
             else
               DISPLAY "MPA005: ", getct " test suite types found in
      -    " MP5_TT"
               DISPLAY "MPA005 normal completion"
             END-IF

             EXEC SQL DELETE FROM MP5_AA END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL DELETE FROM MP5_AA_INDEX END-EXEC
             MOVE SQLCODE TO SQL-COD
             EXEC SQL COMMIT WORK END-EXEC
             MOVE SQLCODE TO SQL-COD
      *NOTE that for debugging, MP5_TT still contains rows 

      ******************** END TEST0457 *******************



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

      *    ****  Procedures for PERFORM statements