|
IDENTIFICATION DIVISION.
PROGRAM-ID. MPA005.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. xyz.
OBJECT-COMPUTER. xyz.
DATA DIVISION.
WORKING-STORAGE SECTION.
* Standard COBOL (file "MPA005.SCO") calling SQL
* procedures in file "MPA005.MCO".
* STANDARD COBOL (file "MPA005.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.
*
* MPA005.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 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;
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, mpa005.
- "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
*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;
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 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;
CALL "SUB3" USING SQLCODE
MOVE SQLCODE TO SQL-COD
if (SQLCODE < 0) then
MOVE 1 TO code1
END-IF
* EXEC SQL DELETE FROM MP5_AA_INDEX;
CALL "SUB4" USING SQLCODE
MOVE SQLCODE TO SQL-COD
if (SQLCODE < 0) then
MOVE 1 TO code1
END-IF
* EXEC SQL DELETE FROM MP5_TT;
CALL "SUB5" USING SQLCODE
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;
CALL "SUB6" USING SQLCODE
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;
CALL "SUB7" USING SQLCODE
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;
CALL "SUB8" USING SQLCODE del1 del2
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;
CALL "SUB9" USING SQLCODE del1 del2
MOVE SQLCODE TO SQL-COD
if (SQLCODE < 0) then
MOVE 1 TO code1
END-IF
* EXEC SQL COMMIT WORK;
if code1 = 0 then
CALL "SUB10" USING SQLCODE
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"
CALL "SUB7" USING SQLCODE
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);
CALL "SUB11" USING SQLCODE seqno
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);
CALL "SUB12" USING SQLCODE seqno
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;
CALL "SUB13" USING SQLCODE CC
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;
CALL "SUB14" USING SQLCODE
MOVE SQLCODE TO SQL-COD
DISPLAY "MPA005: ROLLBACK due to nonzero SQLCODE
- " (Deadlock?)"
GO TO P115
END-IF
* EXEC SQL COMMIT WORK;
CALL "SUB15" USING SQLCODE
MOVE SQLCODE TO SQL-COD
if (SQLCODE NOT = 0) then
DISPLAY "MPA005: Cannot commit batch of INSERTs"
* EXEC SQL ROLLBACK WORK;
CALL "SUB16" USING SQLCODE
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;
CALL "SUB17" USING SQLCODE CC
MOVE SQLCODE TO SQL-COD
* EXEC SQL COMMIT WORK;
CALL "SUB18" USING SQLCODE
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;
CALL "SUB19" USING SQLCODE getct
MOVE SQLCODE TO SQL-COD
if (SQLCODE NOT = 0) then
MOVE 0 TO getct
END-IF
* EXEC SQL COMMIT WORK;
CALL "SUB20" USING SQLCODE
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;
CALL "SUB21" USING SQLCODE getct
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;
CALL "SUB22" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL DELETE FROM MP5_AA_INDEX;
CALL "SUB23" USING SQLCODE
MOVE SQLCODE TO SQL-COD
* EXEC SQL COMMIT WORK;
CALL "SUB24" USING SQLCODE
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
¤ Dauer der Verarbeitung: 0.27 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.
|
