Quelle  mpb005.cob

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


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

      ****************************************************************
      *                                                              
      *                 COMMENT SECTION                              
      *                                                              
      * DATE Halloween 1991 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.
      *                                                              
      * MPB005.SCO                                                    
      * 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  uid PIC  X(18).
       01  uidx PIC  X(18).
       01  CC PIC  X(2).
      *  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  seqno PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  chekct PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  errflg 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  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  tranct PIC S9(9) DISPLAY SIGN LEADING SEPARATE.
       01  mpbins 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;
             CALL "SUB1" USING SQLCODE uidx
             MOVE SQLCODE TO SQL-COD
             if (uid  NOT  =   uidx) then
               DISPLAY "ERROR: User ", uid " expected.  User ", uidx "
      -    " connected"
             END-IF
             MOVE 0 TO errcnt
             DISPLAY "SQL Test Suite, V6.0, Standard COBOL, mpb005.
      -    "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

      *transactions are inserted in multiples of the value of tranct 
             MOVE 5 TO tranct
      *MPB005 will insert 12 rows into MP5_TT for this test suite type
             MOVE 24 TO mpbins

      *concurrency tuning variables follow: 
      *wait pauze units between transactions in a set 
      *wait pauze2 units between sets of transations 
             MOVE 1 TO pauze
             MOVE 20 TO pauze2

      *  EXEC SQL COMMIT WORK;
             CALL "SUB2" USING SQLCODE
             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 B 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 " *** and counts, ensuring that only multiples of 5
      -    " "
             DISPLAY " *** are found."
             DISPLAY " "

             MOVE 0 TO seqno
             MOVE 0 TO errflg

      *           -----Concurrent Transaction Loop----- 

      *Count MP5_AA for phantom (uncommitted) rows 
           .
        P110.
             MOVE 0 TO code1
      *  EXEC SQL SELECT COUNT(*) INTO :getct FROM MP5_AA;
             CALL "SUB3" USING SQLCODE getct
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  NOT =  0) then
               DISPLAY "MPB005: Negative SQLCODE counting MP5_AA
      -    " (Deadlock?)"
      *    EXEC SQL ROLLBACK WORK;
               CALL "SUB4" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
               GO TO P110
             END-IF

      *Has MPA005 started yet? 
             if (getct  =  0) then
               DISPLAY "Please start MPA005"
      *  EXEC SQL COMMIT WORK;
             CALL "SUB2" USING SQLCODE
               GO TO P110
             END-IF

      *  EXEC SQL INSERT INTO MP5_TT VALUES ('PC',:getct);
             CALL "SUB5" USING SQLCODE getct
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  NOT =  0) then
               MOVE 1 TO code1
             END-IF
      *  EXEC SQL COMMIT WORK;
             CALL "SUB6" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  NOT =  0  OR  code1  NOT =  0) then
               DISPLAY "MPB005:1: Negative SQLCODE inserting into
      -    " MP5_AA"
      *    EXEC SQL ROLLBACK WORK;
               CALL "SUB7" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
               GO TO P110
             END-IF
             DISPLAY getct " rows counted in table MP5_AA"
             COMPUTE seqno = seqno + 1
      *Is getct a multiple of tranct? 
             COMPUTE chekct = getct / tranct
             COMPUTE chekct = chekct * tranct
             if (chekct  NOT =  getct) then
               MOVE 1 TO errflg
             END-IF

      *pause a little 
             MOVE 0 TO iii
           .
        P118.
      *  EXEC SQL SELECT C1 INTO :CC FROM HU.ECCO;
             CALL "SUB8" USING SQLCODE CC
             MOVE SQLCODE TO SQL-COD
      *  EXEC SQL COMMIT WORK;
             CALL "SUB9" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
             COMPUTE iii = iii + 1
             if (iii  <  pauze) then
               GO TO P118
             END-IF
      *end of pause 


      *Read MP5_AA for phantom (uncommitted) rows 
           .
        P120.
             MOVE 0 TO code1
      *  EXEC SQL DECLARE MP5_CURSOR1 CURSOR FOR
      *    SELECT ANUM FROM MP5_AA END-EXEC
      *  EXEC SQL OPEN MP5_CURSOR1;
             CALL "SUB10" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  NOT =  0) then
               MOVE 1 TO code1
             END-IF
             MOVE 0 TO ii

           .
        P122.
      *count rows in table MP5_AA 
      *  EXEC SQL FETCH MP5_CURSOR1 INTO :getct;
             CALL "SUB11" USING SQLCODE getct
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  =  0) then
               COMPUTE ii = ii + 1
               GO TO P122
             END-IF
             if (SQLCODE  <  0) then
               MOVE 1 TO code1
             END-IF

             if (code1  NOT =  0) then
               DISPLAY "MPB005: Negative SQLCODE reading MP5_AA
      -    " (Deadlock?)"
      *    EXEC SQL ROLLBACK WORK;
               CALL "SUB12" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
               GO TO P120
             END-IF
             MOVE ii TO getct
      *  EXEC SQL INSERT INTO MP5_TT VALUES ('PC',:getct);
             CALL "SUB13" USING SQLCODE getct
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  NOT =  0) then
               MOVE 1 TO code1
             END-IF
      *  EXEC SQL COMMIT WORK;
             CALL "SUB14" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  NOT =  0  OR  code1  NOT =  0) then
               DISPLAY "MPB005:2: Negative SQLCODE inserting into
      -    " MP5_TT"
      *    EXEC SQL ROLLBACK WORK;
               CALL "SUB15" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
               GO TO P120
             END-IF
             DISPLAY getct " rows fetched from table MP5_AA"
             COMPUTE seqno = seqno + 1
      *Is getct a multiple of tranct? 
             COMPUTE chekct = getct / tranct
             COMPUTE chekct = chekct * tranct
             if (chekct  NOT =  getct) then
               MOVE 1 TO errflg
             END-IF

      *pause a little 
             MOVE 0 TO iii
           .
        P128.
      *  EXEC SQL SELECT C1 INTO :CC FROM HU.ECCO;
             CALL "SUB16" USING SQLCODE CC
             MOVE SQLCODE TO SQL-COD
      *  EXEC SQL COMMIT WORK;
             CALL "SUB17" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
             COMPUTE iii = iii + 1
             if (iii  <  pauze) then
               GO TO P128
             END-IF
      *end of pause 


      *Count MP5_AA_INDEX for phantom (uncommitted) rows 
           .
        P130.
             MOVE 0 TO code1
      *  EXEC SQL SELECT COUNT(*) INTO :getct FROM MP5_AA_INDEX
      * ;
             CALL "SUB18" USING SQLCODE getct
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  NOT =  0) then
               DISPLAY "MPB005: Negative SQLCODE counting MP5_AA_INDEX
      -    " (Deadlock?)"
      *    EXEC SQL ROLLBACK WORK;
               CALL "SUB19" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
               GO TO P130
             END-IF
      *  EXEC SQL INSERT INTO MP5_TT VALUES ('PC',:getct);
             CALL "SUB20" USING SQLCODE getct
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  NOT =  0) then
               MOVE 1 TO code1
             END-IF
      *  EXEC SQL COMMIT WORK;
             CALL "SUB21" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  NOT =  0  OR  code1  NOT =  0) then
               DISPLAY "MPB005:3: Negative SQLCODE inserting into
      -    " MP5_TT"
      *    EXEC SQL ROLLBACK WORK;
               CALL "SUB22" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
               GO TO P130
             END-IF
             DISPLAY getct " rows counted in table MP5_AA_INDEX"
             COMPUTE seqno = seqno + 1
      *Is getct a multiple of tranct? 
             COMPUTE chekct = getct / tranct
             COMPUTE chekct = chekct * tranct
             if (chekct  NOT =  getct) then
               MOVE 1 TO errflg
             END-IF

      *pause a little 
             MOVE 0 TO iii
           .
        P138.
      *  EXEC SQL SELECT C1 INTO :CC FROM HU.ECCO;
             CALL "SUB23" USING SQLCODE CC
             MOVE SQLCODE TO SQL-COD
      *  EXEC SQL COMMIT WORK;
             CALL "SUB24" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
             COMPUTE iii = iii + 1
             if (iii  <  pauze) then
               GO TO P138
             END-IF
      *end of pause 


      *Read MP5_AA_INDEX for phantom (uncommitted) rows 
           .
        P140.
             MOVE 0 TO code1
      *  EXEC SQL DECLARE MP5_CURSOR2 CURSOR FOR
      *    SELECT ANUM FROM MP5_AA_INDEX END-EXEC
      *  EXEC SQL OPEN MP5_CURSOR2;
             CALL "SUB25" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  NOT =  0) then
               MOVE 1 TO code1
             END-IF
             MOVE 0 TO ii

           .
        P142.
      *count rows in table MP5_AA_INDEX 
      *  EXEC SQL FETCH MP5_CURSOR2 INTO :getct;
             CALL "SUB26" USING SQLCODE getct
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  =  0) then
               COMPUTE ii = ii + 1
               GO TO P142
             END-IF
             if (SQLCODE  <  0) then
               MOVE 1 TO code1
             END-IF

             if (code1  NOT =  0) then
               DISPLAY "MPB005: Negative SQLCODE reading MP5_AA_INDEX
      -    " (Deadlock?)"
      *    EXEC SQL ROLLBACK WORK;
               CALL "SUB27" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
               GO TO P140
             END-IF
             MOVE ii TO getct
      *  EXEC SQL INSERT INTO MP5_TT VALUES ('PC',:getct);
             CALL "SUB28" USING SQLCODE getct
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  NOT =  0) then
               MOVE 1 TO code1
             END-IF
      *  EXEC SQL COMMIT WORK;
             CALL "SUB29" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
             if (SQLCODE  NOT =  0  OR  code1  NOT =  0) then
               DISPLAY "MPB005:4: Negative SQLCODE inserting into
      -    " MP5_TT"
      *    EXEC SQL ROLLBACK WORK;
               CALL "SUB30" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
               GO TO P140
             END-IF
             DISPLAY getct " rows fetched from table MP5_AA_INDEX"
             COMPUTE seqno = seqno + 1
      *Is getct a multiple of tranct? 
             COMPUTE chekct = getct / tranct
             COMPUTE chekct = chekct * tranct
             if (chekct  NOT =  getct) then
               MOVE 1 TO errflg
             END-IF

      *pause a little extra 
             MOVE 0 TO iii
           .
        P148.
      *  EXEC SQL SELECT C1 INTO :CC FROM HU.ECCO;
             CALL "SUB31" USING SQLCODE CC
             MOVE SQLCODE TO SQL-COD
      *  EXEC SQL COMMIT WORK;
             CALL "SUB32" USING SQLCODE
             MOVE SQLCODE TO SQL-COD
             COMPUTE iii = iii + 1
             if (iii  <  pauze2) then
               GO TO P148
             END-IF
      *end of pause 

             if (seqno  <  mpbins) then
               GO TO P110
             END-IF

      *                          -----Evaluation----- 

             DISPLAY " "
             DISPLAY "The number of rows in MP5_AA or MP5_AA_INDEX"
             DISPLAY "   must always be a multiple of ", tranct "."

             if ( errflg  =  0) then
               DISPLAY "mpb005.sco:        *** pass *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0457','pass','MCO');
               CALL "SUB33" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
             else
               DISPLAY "mpb005.sco:        *** fail *** "
      *    EXEC SQL INSERT INTO HU.TESTREPORT
      *      VALUES('0457','fail','MCO');
               CALL "SUB34" USING SQLCODE
               MOVE SQLCODE TO SQL-COD
               COMPUTE errcnt = errcnt + 1
             END-IF

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

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

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



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

      *    ****  Procedures for PERFORM statements