|
IDENTIFICATION DIVISION.
PROGRAM-ID. MPB005.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. xyz.
OBJECT-COMPUTER. xyz.
DATA DIVISION.
WORKING-STORAGE SECTION.
* Embedded SQL COBOL ("MPB005.PCO") translated from
* Embedded COBOL on Thu Nov 7 11:40:29 1991.
* EMBEDDED COBOL (file "MPB005.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.
*
* MPB005.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 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 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, mpb005.
- "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
*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 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 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 END-EXEC
MOVE SQLCODE TO SQL-COD
if (SQLCODE NOT = 0) then
DISPLAY "MPB005: Negative SQLCODE counting MP5_AA
- " (Deadlock?)"
EXEC SQL ROLLBACK WORK END-EXEC
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 END-EXEC
GO TO P110
END-IF
EXEC SQL INSERT INTO MP5_TT VALUES ('PC',:getct) END-EXEC
MOVE SQLCODE TO SQL-COD
if (SQLCODE NOT = 0) then
MOVE 1 TO code1
END-IF
EXEC SQL COMMIT WORK END-EXEC
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 END-EXEC
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 END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL COMMIT WORK END-EXEC
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 END-EXEC
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 END-EXEC
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 END-EXEC
MOVE SQLCODE TO SQL-COD
GO TO P120
END-IF
MOVE ii TO getct
EXEC SQL INSERT INTO MP5_TT VALUES ('PC',:getct) END-EXEC
MOVE SQLCODE TO SQL-COD
if (SQLCODE NOT = 0) then
MOVE 1 TO code1
END-IF
EXEC SQL COMMIT WORK END-EXEC
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 END-EXEC
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 END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL COMMIT WORK END-EXEC
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
END-EXEC
MOVE SQLCODE TO SQL-COD
if (SQLCODE NOT = 0) then
DISPLAY "MPB005: Negative SQLCODE counting MP5_AA_INDEX
- " (Deadlock?)"
EXEC SQL ROLLBACK WORK END-EXEC
MOVE SQLCODE TO SQL-COD
GO TO P130
END-IF
EXEC SQL INSERT INTO MP5_TT VALUES ('PC',:getct) END-EXEC
MOVE SQLCODE TO SQL-COD
if (SQLCODE NOT = 0) then
MOVE 1 TO code1
END-IF
EXEC SQL COMMIT WORK END-EXEC
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 END-EXEC
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 END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL COMMIT WORK END-EXEC
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 END-EXEC
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 END-EXEC
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 END-EXEC
MOVE SQLCODE TO SQL-COD
GO TO P140
END-IF
MOVE ii TO getct
EXEC SQL INSERT INTO MP5_TT VALUES ('PC',:getct) END-EXEC
MOVE SQLCODE TO SQL-COD
if (SQLCODE NOT = 0) then
MOVE 1 TO code1
END-IF
EXEC SQL COMMIT WORK END-EXEC
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 END-EXEC
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 END-EXEC
MOVE SQLCODE TO SQL-COD
EXEC SQL COMMIT WORK END-EXEC
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.pco: *** pass *** "
EXEC SQL INSERT INTO HU.TESTREPORT
VALUES('0457','pass','PCO') END-EXEC
MOVE SQLCODE TO SQL-COD
else
DISPLAY "mpb005.pco: *** fail *** "
EXEC SQL INSERT INTO HU.TESTREPORT
VALUES('0457','fail','PCO') END-EXEC
MOVE SQLCODE TO SQL-COD
COMPUTE errcnt = errcnt + 1
END-IF
DISPLAY " "
DISPLAY
"===================================================="
EXEC SQL COMMIT WORK END-EXEC
MOVE SQLCODE TO SQL-COD
******************** END TEST0457 *******************
**** TESTER MAY CHOOSE TO INSERT CODE FOR errcnt > 0
STOP RUN.
* **** Procedures for PERFORM statements
¤ Dauer der Verarbeitung: 0.23 Sekunden
(vorverarbeitet)
¤
|
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.
|
