Trailing-Edge
-
PDP-10 Archives
-
BB-4148F-BM_1984
-
uetp/dtvrb1.fml
There is 1 other file named dtvrb1.fml in the archive. Click here to see a list.
* Program DTVRB1 - Basic DML Verb Test Main Program
* (offshoot of BAS01F.TDM)
* Part of the UETP and verify test system for DBMS-20
* Copyright (C) 1984 by
* Digital Equipment Corporation, Maynard, Mass.
*
* This software is furnished under a license, and may be used
* or copied only in accordance with the terms of that license.
C LARGE DML TEST, ENCOMPASSING AT LEAST ONE OF ALL DML
C SYNTACTICAL CONSTRUCTS, PLUS AUXILARY FUNCTIONS AND ROUTINES
C USED TO TEST DML VERB PROCESSORS, AND DBCS IN GENERAL
C LAST UNIQUE ERROR NUMBER = 294
PROGRAM DTVRB1
C THE BASIC DML VERB TESTS
COMMON IER,IGN
C *******************
C * SIMPLE INVOKE *
C *******************
*DBMS
INVOKE DTSSV1 OF DTVRB.
C ********************************
C * USE PROCEDURE DECLARATIONS *
C ********************************
C NO INVOKE USE PROC SINCE SETUP AFTER INVOKE
C NOTE THAT SINCE SYSCOM ITEMS ARE IN COMMON BLOCK NAMED
C AFTER SUB-SCHEMA, WITH 2 SUB-SCHEMAS EACH TRYING TO SHARE
C THE SAME ERROR PROCS, EACH MUST HAVE AN OPUTER LAYER
C SUB-SCHEMA SPECIFIC TO PASS INFO ALONG
C THEREFORE EEON1 AND EEON2 JACKET EEON PROCESSOR
*DBMS
USE EEON1 IF ERROR-STATUS IS 0307,0326. ! FIND ESA, NRS
*DBMS
USE EUMR1 IF ERSTAT 0009. !ANY UMR
* DBMS
USE EDEL1 IF ERSTAT 0200. !ANY DELETE EXCEP
*DBMS
USE EGEN1 IF ERROR-STATUS. !ANY EXCEP NOT CASED ABOVE
TYPE 9991
9991 FORMAT(' [Beginning basic DML tests]'/)
C *********************************
C * BASIC OPEN/CLOSE USAGES *
C * SOME JM???? JRN MANIP CALLS *
C * PLUS JRDATA & JRTEXT CALLS *
* * VARIOUS OTHER VERBS AS WELL *
C *********************************
IER=0
IGN=0
IPAD=40
CALL JMDISK
*DBMS
OPEN ALL USAGE-MODE IS UPDATE PRIVACY KEY IS BADM.
OIC=2
*DBMS
STORE O1.
C MUST CHECK PADDING OF SYSCOM ITEMS
C V6 SPACE PADDED AFTER MOVE STATUS, NUL PADDED AFTER OTHERS
C V6.1 SPACE PADS ALL AS DISTRIBUTED BUT CUST MAY SELECT 6 BEHAV
C DEFAULT IPAD=<>0=ALL BLANKS, =0=V6 BEHAV
IF(RECNAM(2).EQ.0)IPAD=0
P1AREA(1)='TESTA'
P1AREA(2)='2 '
DIRKE2=0
CALL JRTEXT('ABOUT TO STORE A P1 RECORD')
*DBMS
STORE P1.
C CHECKOUT SYSCOM
IF(IPAD.EQ.0)GO TO 10
IF(RECNAM(1).NE.'P1 ' .OR. RECNAM(2).NE.' '
1 .OR. RECNAM(3).NE.' ' .OR. RECNAM(4).NE.' '
2 .OR. RECNAM(5).NE.' ')STOP '?8880B1'
IF(ARNAM(1).NE.'TESTA' .OR. ARNAM(2).NE.'2 '
1 .OR. ARNAM(3).NE.' ' .OR. ARNAM(4).NE.' '
2 .OR. ARNAM(5).NE.' ')STOP '?8881B1'
GO TO 20
10 IF(RECNAM(1).NE.('P1 '.AND."777760000000)
1 .OR. RECNAM(2).NE.0 .OR. RECNAM(3).NE.0
2 .OR. RECNAM(4).NE.0 .OR. RECNAM(5).NE.0)STOP '?8882B1'
IF(ARNAM(1).NE.'TESTA'
1 .OR. ARNAM(2).NE.('2 '.AND."774000000000)
1 .OR. ARNAM(3).NE.0 .OR. ARNAM(4).NE.0
2 .OR. ARNAM(5).NE.0)STOP '?8883B1'
20 MOVE STATUS RUN-UNIT TO I1.
IF(DBKEY.NE.I1)STOP '?8884B1'
CALL JRTEXT('P1 RECORD STORED')
*DBMS
CLOSE JOURNAL.
OPEN AREA TESTA1 USAGE-MODE IS RETRIEVAL PRIVACY KEY BRET.
OPEN AREA TESTA2 USAGE-MODE EXCLUSIVE RETRIEVAL.
FIND O1.
IF(ERSTAT.NE.0)STOP '?8885B1'
MOVE STATUS RUN-UNIT TO I1.
IF(DBKEY.NE.I1)STOP '?8886B1'
GET.
IGN=809
MODIFY O1.
IF(ERSTAT.NE.809)STOP '?8853B1'
IF(IER.NE.809)STOP '?8887B1'
IGN=0
FIND FIRST RECORD OF TESTA2 AREA.
IF(ERSTAT.NE.0)STOP '?8888B1'
IGN=209
DELETE.
IF(ERSTAT.NE.209)STOP '?8854B1'
IF(IER.NE.209)STOP '??8889B1'
IGN=0
CLOSE RUN-UNIT.
CALL JMNAME('DSK:DTVRB.JRN')
CALL JMAFT(0)
*DBMS
OPEN JOURNAL USAGE-MODE UPDATE.
*DBMS
OPEN AREA TESTA1 USAGE-MODE PROTECTED RETRIEVAL PRIVACY KEY BPRET.
*DBMS
OPEN AREA TESTA2 USAGE-MODE PROTECTED UPDATE.
M2D1=20
*DBMS
STORE M2.
IGN=706
*DBMS
INSERT M2 INTO ALL SETS.
IF(ERSTAT.NE.706)STOP '?8855B1'
IF(IER.NE.706)STOP '?8890B1'
C CHECKOUT SYSCOM
IF(IPAD.EQ.0)GO TO 30
IF(ERREC(1).NE.'M2 ' .OR. ERREC(2).NE.' '
1 .OR. ERREC(3).NE.' ' .OR. ERREC(4).NE.' '
2 .OR. ERREC(5).NE.' ')STOP '?8891B1'
IF(ERAREA(1).NE.'TESTA' .OR. ERAREA(2).NE.'2 '
1 .OR. ERAREA(3).NE.' ' .OR. ERAREA(4).NE.' '
2 .OR. ERAREA(5).NE.' ')STOP '?8892B1'
IF(ERSET(1).NE.'O1M2 ' .OR. ERSET(2).NE.' '
1 .OR. ERSET(3).NE.' ' .OR. ERSET(4).NE.' '
2 .OR. ERSET(5).NE.' ')STOP '?8893B1'
GO TO 40
30 IF(ERREC(1).NE.('M2 '.AND."777760000000)
1 .OR. ERREC(2).NE.0
2 .OR. ERREC(3).NE.0 .OR. ERREC(4).NE.0
3 .OR. ERREC(5).NE.0)STOP '?8894B1'
IF(ERAREA(1).NE.'TESTA'
1 .OR. ERAREA(2).NE.('2 '.AND."774000000000)
2 .OR. ERAREA(3).NE.0 .OR. ERAREA(4).NE.0
3 .OR. ERAREA(5).NE.0)STOP '?8895B1'
IF(ERSET(1).NE.('O1M2 '.AND."777777777400)
1 .OR. ERSET(2).NE.0
2 .OR. ERSET(3).NE.0 .OR. ERSET(4).NE.0
3 .OR. ERSET(5).NE.0)STOP '?8896B1'
40 IGN=0
CALL JRDATA(SYSCOM,44)
*DBMS
CLOSE AREA TESTA1,TESTA2.
*DBMS
CLOSE JOURNAL.
CALL JMBOTH('TESTA1','TESTA2')
OPEN ALL USAGE-MODE EXCLUSIVE UPDATE PRIVACY KEY BEUPD.
OPEN TRANSACTION TU.
CALL JRTEXT('DELETEING ALL RECORDS')
FIND FIRST O1 RECORD OF TESTA1 AREA.
IF(ERSTAT.NE.0)STOP '?8897B1'
DELETE ALL.
FIND FIRST P1 RECORD OF TESTA2 AREA.
IF(ERSTAT.NE.0)STOP '?8898B1'
DELETE P1.
FIND M2.
IF(ERSTAT.NE.0)STOP '?8899B1'
DELETE.
CALL JRDATA(SYSCOM,44)
CLOSE TRANSACTION TU.
CLOSE ALL.
CLOSE RUN-UNIT.
CALL JMNONE('TESTA2')
*DBMS
OPEN JOURNAL USAGE-MODE EXCLUSIVE UPDATE.
IGN=938
*DBMS
OPEN ALL USAGE-MODE UPDATE PRIVACY KEY BADM.
IF(ERSTAT.NE.938)STOP '?8856B1'
IF(IER.NE.938)STOP '?88104B1'
IGN=0
*DBMS
CLOSE JOURNAL.
CALL JMBEF('TESTA2')
OPEN AREA TESTA2 USAGE-MODE EXCLUSIVE UPDATE.
IGN=938
OPEN AREA TESTA1 USAGE-MODE IS UPDATE PRIVACY KEY IS BUPD.
IF(ERSTAT.NE.938)STOP '?8857B1'
IF(IER.NE.938)STOP '?88138B1'
IGN=0
CLOSE JOURNAL.
C *****************************
C * SOME TRANSACTION MANIPS *
C *****************************
OPEN AREA TESTA1 USAGE-MODE EXCLUSIVE UPDATE PRIVACY KEY BEUPD.
OPEN TRANSACTION TUA1.
O1C=99
O1D1=99
STORE O1.
CLOSE TRANSACTION.
CALL JSTRAN('O1MANIP',1)
FIND O1 RECORD.
IF(ERSTAT.NE.0)STOP '?88100B1'
O1D1=30
MODIFY.
CALL JETRAN('O1MANIP',1)
OPEN TRANSACTION TUA1.
FIND O1 RECORD.
IF(ERSTAT.NE.0)STOP '?88101B1'
O1D1=40
MODIFY O1 O1C,O1D1.
DELETE TRANSACTION TUA1.
CALL JSTRAN('O1READ',2)
FIND CURRENT OF O1 RECORD.
IF(ERSTAT.NE.0)STOP '?88102B1'
DELETE O1.
CALL JBTRAN(0)
CALL JSTRAN('O1NEGATE',3)
FIND O1.
IF(ERSTAT.NE.0)STOP '?88103B1'
MODIFY O1.
CALL JBTRAN(2)
OPEN TRANSACTION TUA1.
DELETE O1 ALL.
CLOSE TRANSACTION TUA1.
OPEN TRANSACTION TRA1.
FIND O1 RECORD.
IF(ERSTAT.NE.326)STOP '?88105B1'
DELETE TRANSACTION.
CLOSE JOURNAL.
C *******************************
C * SOME MANUAL CALLS TO DBCS *
C *******************************
C OPEN AREA TESTA1 USAGE-MODE UPDATE PRIVACY KEY BUPD
CALL OPEND(-21,0,'BUPD','TESTA1')
C OPEN TRANSACTION TUA1
CALL OPENT('TUA1')
O1C=29
O1D1=29
C STORE O1
CALL STORED('O1')
M1D1=29
M1D2=29
C STORE M1
CALL STORED('M1')
C FIND FIRST M1 RECORD OF O1M1 SET
CALL FIND3(-12,'M1','O1M1',-20)
IF(ERSTAT.NE.0)STOP '?88106B1'
C FIND OWNER OF O1M1 SET
CALL FIND4('O1M1')
IF(ERSTAT.NE.0)STOP '?88107B1'
C GET O1
CALL GETS('O1')
C DELETE O1 ALL
CALL DELETR('O1',-17)
C CLOSE TRANSACTION TUA1
CALL CLOTR('TUA1')
C CLOSE AREA TESTA1
CALL CLOSED(-18,'TESTA1')
C CLOSE JOURNAL
CALL CLOSED(-28)
C ***********************
C * BASIC VERB USAGES *
C ***********************
*DBMS
OPEN AREA TESTA1 USAGE-MODE UPDATE PRIVACY KEY BUPD.
C ******************************************
C * STORES WITH VARYING SUPPRESS CLAUSES *
C * MOVE CURRENCY FOR CHECKING SUPPRESS *
C * SET-PREDICATES WITH BOTH *
C * PLUS SOME FINDS AND DELETES *
C ******************************************
!FIRST THE SET-PREDICATES
O1C=10
O1D1=10
*DBMS
71 STORE O1.
M1D1=11
M1D2=M1D1
STORE M1 SUPPRESS O1M1 CURRENCY UPDATES.
FIND CURRENT OF O1M1 SET SUPPRESS ALL.
IF(ERSTAT.NE.0)STOP '?88108B1'
IF (.NOT. OWNER('O1M1')) STOP '?881B1'
IF (MEMBER('O1M1')) STOP '?882B1'
IF (EMPTY('O1M1')) STOP '?883B1'
IF (.NOT. TENANT('O1M1')) STOP '?8858B1'
IF (.NOT. OWNER(0)) STOP '?8859B1'
IF (MEMBER(0)) STOP '?8860B1'
IF (.NOT. TENANT(0)) STOP '?8861B1'
72 FIND CURRENT OF M1 RECORD.
IF(ERSTAT.NE.0)STOP '?88109B1'
IF (.NOT. TENANT('O1M1')) STOP '?884B1'
IF (.NOT. MEMBER ('O1M1')) STOP '?885B1'
IF (EMPTY('O1M1')) STOP '?886B1' !THIS CURR SET OCC IDENT BY MEM
IF (OWNER('O1M1')) STOP '?8862B1'
IF (.NOT. TENANT(0)) STOP '?8863B1'
IF (.NOT. MEMBER(0)) STOP '?8864B1'
IF (OWNER(0)) STOP '?8865B1'
!NOW MOVE CURRENCY
1000 MOVE STATUS RUN-UNIT TO IRU.
MOVE CURRENCY STATUS FOR TESTA1 AREA TO IA1.
IF(ARNAM(1).NE.'TESTA' .OR. ARNAM(2).NE.'1 '
1 .OR. ARNAM(3).NE.' ' .OR. ARNAM(4).NE.' '
2 .OR. ARNAM(5).NE.' ')STOP '?88110B1'
MOVE CURRENCY STATUS O1 RECORD TO IO1.
IF(RECNAM(1).NE.'O1 ' .OR. RECNAM(2).NE.' '
1 .OR. RECNAM(3).NE.' ' .OR. RECNAM(4).NE.' '
2 .OR. RECNAM(5).NE.' ')STOP '?88111B1'
MOVE STATUS O1M1 SET TO IO1M1.
MOVE STATUS O1M2 SET TO IO1M2.
O1C=1000
O1D1=O1C
STORE O1 SUPPRESS ALL CURRENCY.
MOVE STATUS RUN-UNIT TO JRU.
MOVE CURRENCY STATUS FOR TESTA1 AREA TO JA1.
MOVE CURRENCY STATUS O1 RECORD TO JO1.
MOVE STATUS O1M1 SET TO JO1M1.
MOVE STATUS O1M2 SET TO JO1M2.
IF(IA1.NE.JA1 .OR. IO1.NE.JO1 .OR. IO1M1.NE.JO1M1
1 .OR. IO1M2.NE.JO1M2)STOP '?8866B1'
IF(IRU.EQ.JRU)STOP '?8867B1'
FIND CURRENT OF RUN-UNIT.
IF(ERSTAT.NE.0)STOP '?88112B1'
MOVE STATUS RUN-UNIT TO IRU.
MOVE CURRENCY STATUS FOR TESTA1 AREA TO IA1.
MOVE CURRENCY STATUS O1 RECORD TO IO1.
MOVE STATUS O1M1 SET TO IO1M1.
MOVE STATUS O1M2 SET TO IO1M2.
IF(IA1.EQ.JA1 .OR. IO1.EQ.JO1 .OR. IO1M1.EQ.JO1M1
1 .OR. IO1M2.EQ.JO1M2)STOP '?8868B1'
IF(IRU.NE.JRU)STOP '?8869B1'
!AND THE REMAINING STORE SUPPRESS VARIANTS
M1D1=21
1001 STORE M1 SUPPRESS RECORD UPDATES.
FIND CURRENT OF M1 RECORD.
IF(ERSTAT.NE.0)STOP '?88113B1'
GET.
IF(M1D1.NE.11)STOP '?8870B1'
M1D2=30
MODIFY M1,M1D2.
M1D2=0
GET M1,M1D2.
IF(M1D2.NE.30)STOP '?88114B1'
M1D1=31
1002 STORE M1 SUPPRESS AREA.
FIND CURRENT OF TESTA1 AREA.
IF(ERSTAT.NE.0)STOP '?88115B1'
GET M1.
IF(M1D1.NE.11)STOP '?8871B1'
MODIFY.
O1C=2000
MOVE STATUS O1M1 SET TO IO1M1.
MOVE STATUS O1M2 SET TO IO1M2.
1003 STORE O1 SUPPRESS SET CURRENCY UPDATES.
MOVE STATUS O1M1 SET TO JO1M1.
MOVE STATUS O1M2 SET TO JO1M2.
IF(IO1M1.NE.JO1M1 .OR. IO1M2.NE.JO1M2)STOP '?8872B1'
FIND CURRENT OF RUN-UNIT.
IF(ERSTAT.NE.0)STOP '?88116B1'
M1D1=41
MOVE STATUS M1 RECORD TO IM1.
MOVE STATUS O1M1 SET TO IO1M1.
1004 STORE M1 SUPPRESS RECORD, O1M1 UPDATES.
MOVE STATUS M1 RECORD TO JM1.
MOVE STATUS O1M1 SET TO JO1M1.
IF(IM1.NE.JM1 .OR. IO1M1.NE.JO1M1)STOP '?8873B1'
M1D1=51
MOVE STATUS TESTA1 AREA TO IA1.
1005 STORE M1 SUPPRESS AREA O1M1 CURRENCY.
MOVE STATUS TESTA1 AREA TO JA1.
MOVE STATUS O1M1 SET TO JO1M1.
IF(IA1.NE.JA1 .OR. IO1M1.NE.JO1M1)STOP '?8874B1'
O1C=3000
MOVE STATUS O1 RECORD TO IO1.
MOVE STATUS O1M2 SET TO IO1M2.
1006 STORE O1 SUPPRESS RECORD SET CURRENCY UPDATES.
MOVE STATUS O1 RECORD TO JO1.
MOVE STATUS O1M1 SET TO JO1M1.
MOVE STATUS O1M2 SET TO JO1M2.
IF(IO1.NE.JO1 .OR. IO1M1.NE.JO1M1 .OR. IO1M2.NE.JO1M2)
1 STOP '?8875B1'
FIND CURRENT OF RUN-UNIT SUPPRESS O1M1.
IF(ERSTAT.NE.0)STOP '?88117B1'
M1D1=61
MOVE STATUS TESTA1 AREA TO IA1.
1007 STORE M1 SUPPRESS AREA SET CURRENCY.
MOVE STATUS TESTA1 AREA TO JA1.
MOVE STATUS O1M1 SET TO JO1M1.
IF(IA1.NE.JA1 .OR. IO1M1.NE.JO1M1) STOP '?8876B1'
FIND CURRENT OF RUN-UNIT.
IF(ERSTAT.NE.0)STOP '?88118B1'
1008 DELETE.
MOVE STATUS M1 RECORD TO IM1.
MOVE STATUS TESTA1 AREA TO IA1.
1009 STORE M1 SUPPRESS RECORD AREA CURRENCY UPDATES.
MOVE STATUS M1 RECORD TO JM1.
MOVE STATUS TESTA1 AREA TO JA1.
IF(IM1.NE.JM1 .OR. IA1.NE.JA1)STOP '?8877B1'
MOVE CURRENCY STATUS FOR O1M1 SET TO IO1M1.
MOVE CURRENCY STATUS FOR O1M2 SET TO IO1M2.
1010 STORE O1 SUPPRESS O1M1, O1M2 CURRENCY.
MOVE STATUS O1M1 SET TO JO1M1.
MOVE STATUS O1M2 SET TO JO1M2.
IF(IO1M1.NE.JO1M1 .OR. IO1M2.NE.JO1M2)STOP '?8878B1'
M1D1=71
MOVE STATUS TESTA1 AREA TO IA1.
1011 STORE M1 SUPPRESS RECORD, AREA, O1M1 UPDATES.
MOVE STATUS FOR TESTA1 AREA TO JA1.
MOVE STATUS M1 RECORD TO JM1.
MOVE STATUS O1M1 SET TO JO1M1.
IF(IA1.NE.JA1 .OR. IM1.NE.JM1 .OR. IO1M1.NE.JO1M1)STOP '?8879B1'
!CLEANUP FOR REST OF TEST
O1C=1000
FIND O1.
IF(ERSTAT.NE.0)STOP '?88119B1'
DELETE ALL.
O1C=2000
FIND O1.
IF(ERSTAT.NE.0)STOP '?88120B1'
DELETE MEMBERS.
DELETE.
O1C=3000
FIND O1.
IF(ERSTAT.NE.0)STOP '?88121B1'
DELETE.
FIND O1.
IF(ERSTAT.NE.0)STOP '?88122B1'
DELETE O1.
O1C=10
FIND O1 RECORD.
IF(ERSTAT.NE.0)STOP '?88123B1'
FIND NEXT RECORD OF O1M1 SET.
IF(ERSTAT.NE.0)STOP '?88124B1'
FIND NEXT RECORD OF O1M1 SET.
IF(ERSTAT.NE.0)STOP '?88125B1'
DELETE M1.
!ONE LAST STORE/SUPPRESS, MOVE CURRENCY CHECK, SETUP FOR LATER
M1D1=12
M1D2=M1D1
73 STORE M1.
MOVE STATUS FOR TESTA1 AREA TO I1.
STORE F1 SUPPRESS AREA UPDATES.
MOVE STATUS FOR TESTA1 AREA TO I2.
MOVE STATUS FOR RUN-UNIT TO J1.
FIND CURRENT OF RUN-UNIT.
IF(ERSTAT.NE.0)STOP '?88236B1'
MOVE CURRENCY STATUS FOR TESTA1 AREA TO J2.
IF (I1.NE.I2) STOP '?887B1'
IF (J1.NE.J2) STOP '?888B1'
IF (I1.EQ.J1) STOP '?889B1'
C ****************************
C * FIND CALC (RSE5) CASES *
C ****************************
74 O1C=23
O1D1=O1C
CALL CALCHN('O1')
K1=DBKEY
STORE O1.
K2=DBKEY
IF(K1/512.NE.K2/512)STOP '?88126B1'
O1C=10
CALL CALCHN('O1')
K1=DBKEY
MOVE STATUS TESTA1 AREA TO IA1.
MOVE STATUS O1 RECORD TO IO1.
MOVE STATUS O1M1 SET TO IO1M1.
FIND O1 SUPPRESS AREA, RECORD, O1M1 CURRENCY.
IF(ERSTAT.NE.0)STOP '?88237B1'
MOVE STATUS TESTA1 AREA TO JA1.
MOVE STATUS O1 RECORD TO JO1.
MOVE STATUS O1M1 SET TO JO1M1.
IF(IA1.NE.JA1)STOP '?88238B1'
IF(IO1.NE.JO1)STOP '?88239B1'
IF(IO1M1.NE.JO1M1)STOP '?88240B1'
K2=DBKEY
IF(K1/512.NE.K2/512)STOP '?88127B1'
IF (ERSTAT.NE.0) STOP '?8810B1'
O1C=0
GET O1.
IF (O1C.NE.10) STOP'?8811B1'
FIND DUPLICATE O1.
IF (ERSTAT.NE.326) STOP '?8812B1'
O1D1=11
75 STORE O1.
MOVE STATUS TESTA1 AREA TO IA1.
MOVE STATUS O1M1 SET TO IO1M1.
MOVE STATUS O1M2 SET TO IO1M2.
MOVE STATUS O1M3 SET TO IO1M3.
MOVE STATUS O1M4 SET TO IO1M4.
FIND O1 RECORD SUPPRESS AREA,SET CURRENCY UPDATES.
IF (ERSTAT.NE.0) STOP '?8813B1'
MOVE STATUS TESTA1 AREA TO JA1.
MOVE STATUS O1M1 SET TO JO1M1.
MOVE STATUS O1M2 SET TO JO1M2.
MOVE STATUS O1M3 SET TO JO1M3.
MOVE STATUS O1M4 SET TO JO1M4.
IF(IA1.NE.JA1)STOP '?88241B1'
IF(IO1M1.NE.JO1M1)STOP '?88242B1'
IF(IO1M2.NE.JO1M2)STOP '?88243B1'
IF(IO1M3.NE.JO1M3)STOP '?88244B1'
IF(IO1M4.NE.JO1M4)STOP '?88245B1'
MOVE STATUS TESTA1 AREA TO IA1.
MOVE STATUS O1 RECORD TO IO1.
MOVE STATUS O1M1 SET TO IO1M1.
MOVE STATUS O1M3 SET TO IO1M3.
* DBMS
FIND NEXT DUPLICATE WITHIN O1 RECORD SUPPRESS
AREA ,O1M1, RECORD, O1M3 UPDATES.
IF (ERSTAT.NE.0) STOP '?8814B1'
MOVE STATUS TESTA1 AREA TO JA1.
MOVE STATUS O1 RECORD TO JO1.
MOVE STATUS O1M1 SET TO JO1M1.
MOVE STATUS O1M3 SET TO JO1M3.
IF(IA1.NE.JA1)STOP '?88246B1'
IF(IO1.NE.JO1)STOP '?88247B1'
IF(IO1M1.NE.JO1M1)STOP '?88248B1'
IF(IO1M3.NE.JO1M3)STOP '?88249B1'
GET O1,O1C.
IF (O1C.NE.10) STOP '?8815B1'
C *******************************************
C * FIND DIRECT (RSE1) *
C * FIND [OWN] CURRENT (RSE2) COMPLICATED *
C * FIND OWNER (RSE4) *
C *******************************************
C I1=I2=DBKEY 2ND M1 IN 1ST O1
C J1=J2=DBKEY F1
76 FIND F1 USING J1.
IF (ERSTAT.NE.0) STOP '?8816B1'
FIND F1 USING I1.
IF (ERSTAT.NE.326) STOP '?8817B1'
FIND USING I1.
IF (ERSTAT.NE.0) STOP '?8818B1'
MOVE STATUS TESTA1 AREA TO IA1.
MOVE STATUS O1 RECORD TO IO1.
MOVE STATUS M1 RECORD TO IM1.
MOVE STATUS O1M1 SET TO IO1M1.
MOVE STATUS O1M2 SET TO IO1M2.
MOVE STATUS O1M3 SET TO IO1M3.
MOVE STATUS O1M4 SET TO IO1M4.
77 FIND OWNER O1M1 CURRENT O1M1 SET SUPPRESS RECORD,AREA,SET.
IF(ERSTAT.NE.0)STOP '?88250B1'
MOVE STATUS TESTA1 AREA TO JA1.
MOVE STATUS O1 RECORD TO JO1.
MOVE STATUS M1 RECORD TO JM1.
MOVE STATUS O1M1 SET TO JO1M1.
MOVE STATUS O1M2 SET TO JO1M2.
MOVE STATUS O1M3 SET TO JO1M3.
MOVE STATUS O1M4 SET TO JO1M4.
IF(IA1.NE.JA1)STOP '?88251B1'
IF(IO1.NE.JO1)STOP '?88252B1'
IF(IM1.NE.JM1)STOP '?88253B1'
IF(IO1M1.NE.JO1M1)STOP '?88254B1'
IF(IO1M2.NE.JO1M2)STOP '?88255B1'
IF(IO1M3.NE.JO1M3)STOP '?88256B1'
IF(IO1M4.NE.JO1M4)STOP '?88257B1'
IF (.NOT. OWNER(0)) STOP '?8819B1'
MOVE STATUS TESTA1 AREA TO IA1.
MOVE STATUS O1 RECORD TO IO1.
FIND OWNER O1M1 CURRENT TESTA1 AREA SUPPRESS RECORD.
IF(ERSTAT.NE.0)STOP '?88258B1'
MOVE STATUS TESTA1 AREA TO JA1.
MOVE STATUS O1 RECORD TO JO1.
IF(IO1.NE.JO1)STOP '?88260B1'
IF(IM1.NE.JM1)STOP '?88261B1'
MOVE STATUS M1 RECORD TO I3.
IF (I1.NE.I3) STOP '?8820B1' !INSURE OLD VALUE
MOVE STATUS O1M1 SET TO K1. !NOW CHK FIND CURR AND STRING MANIP
IF ('O1'.NE.RECNAM(1)) STOP '?8821B1'
1030 M4D1=99
M4D2=999
STORE M4.
INSERT INTO ALL SETS.
MOVE STATUS TESTA1 AREA TO IA1.
MOVE STATUS O1M1 SET TO IO1M1.
FIND LAST M1 RECORD OF TESTA1 AREA SUPPRESS O1M1, AREA CURRENCY UPDATES.
IF(ERSTAT.NE.0)STOP '?88217B1'
MOVE STATUS TESTA1 AREA TO JA1.
MOVE STATUS O1M1 SET TO JO1M1.
IF(IA1.NE.JA1)STOP '?88262B1'
IF(IO1M1.NE.JO1M1)STOP '?88263B1'
MOVE STATUS M1 RECORD TO IM1.
FIND M1 USING IM1.
IF(ERSTAT.NE.0)STOP '?88294B1'
FIND CURRENT OF TESTA1 AREA.
IF(ERSTAT.NE.0)STOP '?88218B1'
MOVE STATUS TESTA1 AREA TO IA1.
IF(IM1.NE.IA1)STOP '?88219B1'
GET.
IF(M1D1.NE.12)STOP '?88220B1'
IF(M1D2.NE.12)STOP '?88221B1'
MOVE STATUS O1M1 SET TO IO1M1.
FIND OWNER IN O1M1 OF CURRENT OF M1 RECORD SUPPRESS O1M1.
IF(ERSTAT.NE.0)STOP '?88264B1'
MOVE STATUS O1M1 SET TO JO1M1.
IF(IO1M1.NE.JO1M1)STOP '?88265B1'
GET.
IF(O1C.NE.10)STOP '?88222B1'
IF(O1D1.NE.10)STOP '?88223B1'
MOVE STATUS RUN-UNIT TO IO1.
FIND FIRST M1 RECORD OF O1M1 SET.
IF(ERSTAT.NE.0)STOP '?88224B1'
FIND OWNER IN O1M1 CURRENT OF RUN-UNIT.
IF(ERSTAT.NE.0)STOP '?88225B1'
MOVE STATUS O1 RECORD TO JO1.
IF(IO1.NE.JO1)STOP '?88226B1'
FIND FIRST M4 RECORD OF O1M4 SET.
IF(ERSTAT.NE.0)STOP '?88227B1'
FIND OWNER IN F1M4 CURRENT OF O1M4 SET.
IF(ERSTAT.NE.0)STOP '?88228B1'
MOVE STATUS F1 RECORD TO J2.
IF(J1.NE.J2)STOP '?88229B1'
FIND CURRENT OF M4 RECORD.
IF(ERSTAT.NE.0)STOP '?88230B1'
FIND OWNER IN F1M4 CURRENT OF TESTA1 AREA.
IF(ERSTAT.NE.0)STOP '?88231B1'
MOVE STATUS RUN-UNIT TO J2.
IF (J1.NE.J2)STOP '?88232B1'
FIND LAST M4 RECORD OF TESTA1 AREA.
IF(ERSTAT.NE.0)STOP '?88233B1'
REMOVE M4 FROM F1M4,O1M4.
DELETE.
78 FIND OWNER OF O1M1.
IF(ERSTAT.NE.0)STOP '?88128B1'
MOVE STATUS FOR O1M1 SET TO K2.
FIND M1 USING I1. !GET OWNER WHEN CURR OF SET IS MEM
IF(ERSTAT.NE.0)STOP '?88129B1'
FIND OWNER OF O1M1.
IF(ERSTAT.NE.0)STOP '?88266B1'
MOVE STATUS FOR O1M1 SET TO K3.
IF (K1.NE.K2) STOP '?8822B1'
IF (K1.NE.K3) STOP '?8823B1'
C ******************************************************
C * FIND NEXT/PRIOR/FIRST/LAST/OFFSET OF AREA (RSE3) *
C ******************************************************
OPEN TRANSACTION TRA1.
MOVE STATUS O1 RECORD TO IO1.
MOVE STATUS O1M3 SET TO IO1M3.
79 FIND FIRST RECORD TESTA1 AREA SUPPRESS O1M3, RECORD.
IF(ERSTAT.NE.0)STOP '?88267B1'
MOVE STATUS O1 RECORD TO JO1.
MOVE STATUS O1M3 SET TO JO1M3.
IF(IO1.NE.JO1)STOP '?88268B1'
IF(IO1M3.NE.JO1M3)STOP '?88269B1'
MOVE STATUS FOR TESTA1 AREA TO L1.
FIND PRIOR RECORD OF TESTA1 AREA. !VERIF REALLY AT 1ST
IF (ERSTAT.NE.307) STOP '?8824B1'
IF(IER.NE.307)STOP '?88194B1'
! NOW FIND ALL RECORDS
LCOUNT=0
11 FIND NEXT RECORD OF TESTA1 AREA.
LCOUNT=LCOUNT+1 !COUNTS FIND BEFORE 1 JUST DONE
IF (ERSTAT.NE.307) GOTO 11
IF (LCOUNT.NE.6) STOP '?8825B1' !THE NUM OF STORE STATS
710 MOVE STATUS FOR TESTA1 AREA TO L2.
MOVE STATUS O1M1 SET TO IO1M1.
MOVE STATUS O1M4 SET TO IO1M4.
FIND LAST RECORD OF TESTA1 AREA SUPPRESS O1M1, O1M4.
IF (ERSTAT.NE.0) STOP '?8826B1' !DON'T WANT NOOP TO BE REASON NEXT TEST SUCS
MOVE STATUS O1M1 SET TO JO1M1.
MOVE STATUS O1M4 SET TO JO1M4.
IF(IO1M1.NE.JO1M1)STOP '?88270B1'
IF(IO1M4.NE.JO1M4)STOP '?88271B1'
MOVE STATUS FOR TESTA1 AREA TO L3.
IF (L2.NE.L3) STOP '?8827B1'
12 FIND PRIOR RECORD OF TESTA1 AREA.
IF (ERSTAT.NE.307) GOTO 12
MOVE STATUS FOR TESTA1 AREA TO L4.
IF (L1.NE.L4) STOP '?8828B1'
MOVE STATUS O1 RECORD TO IO1.
MOVE STATUS O1M1 SET TO IO1M1.
MOVE STATUS O1M2 SET TO IO1M2.
MOVE STATUS O1M3 SET TO IO1M3.
MOVE STATUS O1M4 SET TO IO1M4.
711 FIND LCOUNT RECORD OF TESTA1 AREA SUPPRESS SET RECORD CURRENCY.
IF(ERSTAT.NE.0)STOP '?88272B1'
MOVE STATUS O1 RECORD TO JO1.
MOVE STATUS O1M1 SET TO JO1M1.
MOVE STATUS O1M2 SET TO JO1M2.
MOVE STATUS O1M3 SET TO JO1M3.
MOVE STATUS O1M4 SET TO JO1M4.
IF(IO1.NE.JO1)STOP '?88273B1'
IF(IO1M1.NE.JO1M1)STOP '?88274B1'
IF(IO1M2.NE.JO1M2)STOP '?88275B1'
IF(IO1M3.NE.JO1M3)STOP '?88276B1'
IF(IO1M4.NE.JO1M4)STOP '?88277B1'
MOVE STATUS FOR TESTA1 AREA TO L5.
IF (L2.NE.L5) STOP '?8829B1'
MOVE STATUS O1M1 SET TO IO1M1.
MOVE STATUS O1M2 SET TO IO1M2.
MOVE STATUS O1M3 SET TO IO1M3.
MOVE STATUS O1M4 SET TO IO1M4.
FIND -6 RECORD OF TESTA1 AREA SUPPRESS SET UPDATES.
IF(ERSTAT.NE.0)STOP '?88278B1'
MOVE STATUS O1M1 SET TO JO1M1.
MOVE STATUS O1M2 SET TO JO1M2.
MOVE STATUS O1M3 SET TO JO1M3.
MOVE STATUS O1M4 SET TO JO1M4.
IF(IO1M1.NE.JO1M1)STOP '?88279B1'
IF(IO1M2.NE.JO1M2)STOP '?88280B1'
IF(IO1M3.NE.JO1M3)STOP '?88281B1'
IF(IO1M4.NE.JO1M4)STOP '?88282B1'
MOVE STATUS FOR TESTA1 AREA TO L6.
IF (L1.NE.L6) STOP '?8830B1'
! SPEC A RECORD TYPE EXPLIC (& INVOLVE RANGE SCOPING IN FND.NA)
712 FIND FIRST M1 RECORD OF TESTA1 AREA.
IF (ERSTAT.NE.0) STOP '?8831B1'
FIND NEXT M1 RECORD OF TESTA1 AREA.
IF (ERSTAT.NE.0) STOP '?8832B1'
FIND NEXT M1 RECORD OF TESTA1 AREA. !KNOWN TO BE 2 M1'S, SO SHOULD FAIL
IF (ERSTAT.NE.307) STOP '?8833B1'
FIND LAST M1 RECORD OF TESTA1 AREA.
IF(ERSTAT.NE.0)STOP '?88198B1'
FIND PRIOR M1 RECORD OF TESTA1 AREA.
IF(ERSTAT.NE.0)STOP '?88199B1'
FIND PRIOR M1 RECORD OF TESTA1 AREA.
IF(ERSTAT.NE.307)STOP '?88200B1'
FIND 2 M1 RECORD OF TESTA1 AREA.
IF(ERSTAT.NE.0)STOP '?88201B1'
FIND NEXT M1 RECORD OF TESTA1 AREA.
IF(ERSTAT.NE.307)STOP '?88202B1'
FIND -1 M1 RECORD OF TESTA1 AREA.
IF(ERSTAT.NE.0)STOP '?88203B1'
FIND PRIOR M1 RECORD OF TESTA1 AREA.
IF(ERSTAT.NE.0)STOP '?88204B1'
CLOSE TRANSACTION TRA1.
C *****************************************************
C * FIND NEXT/PRIOR/FIRST/LAST/OFFSET OF SET (RES3) *
C *****************************************************
MOVE STATUS TESTA1 AREA TO IA1.
713 FIND FIRST RECORD O1M1 SET SUPPRESS AREA CURRENCY.
IF(ERSTAT.NE.0)STOP '?88130B1'
MOVE STATUS TESTA1 AREA TO JA1.
IF(IA1.NE.JA1)STOP '?88283B1'
MOVE STATUS FOR O1M1 SET TO N1.
FIND PRIOR RECORD OF O1M1 SET. !VERIF REALLY AT 1ST
IF (ERSTAT.NE.307) STOP '?8835B1'
! NOW FIND ALL RECORDS
NCOUNT=0
16 M1D1=2
M1D2=3
MODIFY M1,M1D2,M1D1.
M1D1=0
M1D2=0
GET M1,M1D1,M1D2.
IF (M1D1.NE.2 .OR. M1D2.NE.3) STOP '?8836B1'
FIND NEXT RECORD OF O1M1 SET.
NCOUNT=NCOUNT+1 !COUNTS FIND BEFORE 1 JUST DONE
IF (ERSTAT.NE.307) GOTO 16
IF (NCOUNT.NE.2) STOP '?8837B1' !THE NUM OF STORE STATS
OPEN TRANSACTION TRA1.
714 MOVE STATUS FOR O1M1 SET TO N2.
! VERIFY FIND OF PRIOR REC USING OB.CPRI
FIND PRIOR RECORD OF O1M1 SET.
IF(ERSTAT.NE.0)STOP '?88284B1'
MOVE STATUS FOR O1M1 SET TO N3.
IF (N1.NE.N3) STOP '?8837AB1'
! VERIF FIND LAST (AGAINST LAST OF 16-LOOP)
FIND LAST RECORD OF O1M1 SET.
IF (ERSTAT.NE.0) STOP '?8838B1' !DON'T WANT NOOP TO BE REASON NEXT TEXT SUCS
MOVE STATUS FOR O1M1 SET TO N3.
IF (N2.NE.N3) STOP '?8839B1'
17 FIND PRIOR RECORD OF O1M1 SET.
IF (ERSTAT.NE.307) GOTO 17
MOVE STATUS FOR O1M1 SET TO N4.
IF (N1.NE.N4) STOP '?8840B1'
MOVE STATUS TESTA1 AREA TO IA1.
MOVE STATUS O1 RECORD TO IO1.
MOVE STATUS M1 RECORD TO IM1.
715 FIND NCOUNT RECORD OF O1M1 SET SUPPRESS AREA RECORD UPDATES.
IF(ERSTAT.NE.0)STOP '?88285B1'
MOVE STATUS TESTA1 AREA TO JA1.
MOVE STATUS O1 RECORD TO JO1.
MOVE STATUS M1 RECORD TO JM1.
IF(IA1.NE.JA1)STOP '?88286B1'
IF(IO1.NE.JO1)STOP '?88287B1'
IF(IM1.NE.JM1)STOP '?88288B1'
MOVE STATUS FOR O1M1 SET TO N5.
IF (N2.NE.N5) STOP '?8841B1'
FIND -2 RECORD OF O1M1 SET.
IF(ERSTAT.NE.0)STOP '?88289B1'
MOVE STATUS FOR O1M1 SET TO N6.
IF (N1.NE.N6) STOP '?8842B1'
CLOSE TRANSACTION.
! SPEC A REC TYPE EXPLIC
716 FIND FIRST M1 RECORD OF O1M1 SET.
IF (ERSTAT.NE.0) STOP '?8843B1'
REMOVE FROM ALL.
FIND NEXT M1 RECORD OF O1M1 SET.
IF (ERSTAT.NE.0) STOP '?8844B1'
FIND NEXT M1 RECORD OF O1M1 SET. !KNOWN TO BE 2 M1'S, SO SHOULD FAIL
IF (ERSTAT.NE.307) STOP '?8845B1'
REMOVE M1 FROM O1M1.
FIND NEXT RECORD OF O1M1 SET.
IF (ERSTAT.NE.326) STOP '?8846B1'
IF(IER.NE.326)STOP '?88195B1'
FIND FIRST M1 RECORD OF TESTA1 AREA.
IF(ERSTAT.NE.0)STOP '?88210B1'
INSERT INTO ALL SETS.
FIND NEXT M1 RECORD OF TESTA1 AREA.
IF(ERSTAT.NE.0)STOP '?88211B1'
INSERT INTO O1M1.
FIND LAST M1 RECORD OF O1M1 SET.
IF(ERSTAT.NE.0)STOP '?88205B1'
FIND PRIOR M1 RECORD O1M1 SET.
IF(ERSTAT.NE.0)STOP '?88206B1'
FIND PRIOR M1 RECORD O1M1 SET.
IF(ERSTAT.NE.307)STOP '?88207B1'
FIND 2 M1 RECORD OF O1M1 SET.
IF(ERSTAT.NE.0)STOP '?88208B1'
FIND NEXT M1 RECORD OF O1M1 SET.
IF(ERSTAT.NE.307)STOP '?88209B1'
FIND -1 M1 RECORD O1M1 SET.
IF(ERSTAT.NE.0)STOP '?88210B1'
REMOVE FROM O1M1.
FIND PRIOR M1 RECORD O1M1 SET.
IF(ERSTAT.NE.0)STOP '?88211B1'
REMOVE FROM ALL.
C ***************************************************
C * FIND SORTED (RSE6) SORTED/UNSORTED, AND FINS6 *
C * PLUS ASSORTED INSERTS AND REMOVES *
C ***************************************************
1050 FIND FIRST F1 RECORD OF TESTA1 AREA.
IF(ERSTAT.NE.0)STOP '?88131B1'
O1C=10
FIND O1 RECORD.
IF(ERSTAT.NE.0)STOP '?88290B1'
M3D1=100
STORE M3.
M3D1=200
STORE M3.
M3D1=150
STORE M3.
M4D1=1000
M4D2=10
STORE M4.
INSERT INTO ALL.
M4D2=20
STORE M4.
INSERT M4 INTO ALL.
M4D1=2000
M4D2=10
STORE M4.
INSERT M4 INTO O1M4,F1M4.
M4D2=20
STORE M4.
INSERT INTO F1M4.
M4D2=30
STORE M4.
INSERT INTO O1M4.
1051 O1C=23
FIND O1 RECORD.
IF(ERSTAT.NE.0)STOP '?88291B1'
M3D1=75
STORE M3.
M3D1=200
STORE M3.
M4D1=1000
M4D2=40
STORE M4.
INSERT M4 INTO ALL SETS.
M4D2=50
STORE M4.
INSERT M4 INTO O1M4.
M4D1=2000
M4D2=40
STORE M4.
INSERT M4 INTO ALL.
M4D1=3000
M4D2=10
STORE M4.
M4D2=20
STORE M4.
INSERT M4 INTO ALL.
O1C=10
C EXACT (NON RANGE) FINDS, SORTED, SINGLE KEY
1052 FIND O1.
IF(ERSTAT.NE.0)STOP '?88139B1'
M3D1=150
FIND M3 VIA CURRENT OF O1M3 USING M3D1.
IF(ERSTAT.NE.0)STOP '?88140B1'
M3D1=75
FIND M3 VIA CURRENT OF O1M3 USING M3D1.
IF(ERSTAT.NE.326)STOP '?88141B1'
1053 O1C=23
FIND O1 RECORD.
IF(ERSTAT.NE.0)STOP '?88142B1'
FIND M3 VIA CURRENT OF O1M3 USING M3D1.
IF(ERSTAT.NE.0)STOP '?88143B1'
CALL FINS6('M3','O1M3')
IF(ERSTAT.NE.0)STOP '?88144B1'
C RANGE CASE FINDS, SORTED, MULTI KEY
1054 M4D1=1000
M4D2=60
FIND M4 VIA CURRENT O1M4 USING M4D1,M4D2.
IF(ERSTAT.NE.0)STOP '?88145B1'
IF(ERDATA.NE.2)STOP '?88146B1'
GET M4.
IF(M4D1.NE.2000)STOP '?88147B1'
IF(M4D2.NE.40)STOP '?88148B1'
M4D1=3000
M4D2=0
FIND M4 VIA CURRENT OF O1M4 USING M4D1,M4D2.
IF(ERSTAT.NE.0)STOP '?88149B1'
IF(ERDATA.NE.1)STOP '?88150B1'
GET M4 M4D1,M4D2.
IF(M4D1.NE.3000)STOP '?88151B1'
IF(M4D2.NE.20)STOP '?88152B1'
C BOUNDARY AND EMPTY CHECKS
M4D2=30
FIND M4 VIA CURRENT O1M4 USING M4D1,M4D2.
IF(ERSTAT.NE.307)STOP '?88153B1'
M3D1=10
FIND M3 VIA CURRENT O1M3 USING M3D1.
IF(ERSTAT.NE.326)STOP '?88154B1'
1055 O1C=10
FIND O1.
IF(ERSTAT.NE.0)STOP '?88155B1'
FIND DUPLICATE O1.
IF(ERSTAT.NE.0)STOP '?88156B1'
FIND M3 VIA CURRENT O1M3 USING M3D1.
IF(ERSTAT.NE.326)STOP '?88157B1'
FIND M4 VIA CURRENT O1M4 USING M4D1,M4D2.
IF(ERSTAT.NE.307)STOP '?88158B1'
C SORTED, NON SORTED FINDS SAME SET OCC
1056 FIND O1. !BACK TO 1ST OCC
IF(ERSTAT.NE.0)STOP '?88196B1'
FIND OWNER F1M4 SET.
IF(ERSTAT.NE.0)STOP '?88197B1'
M4D1=2000
M4D2=10
FIND M4 VIA CURRENT O1M4 USING M4D1,M4D2 SUPPRESS SET.
IF(ERSTAT.NE.0)STOP '?88159B1'
IF(ERDATA.NE.0)STOP '?88160B1'
GET M4.
IF(M4D1.NE.2000)STOP '?88161B1'
IF(M4D2.NE.10)STOP '?88162B1'
FIND M4 VIA CURRENT F1M4 USING M4D1,M4D2 SUPPRESS SET.
IF(ERSTAT.NE.0)STOP '?88163B1'
GET.
IF(M4D1.NE.2000)STOP '?88164B1'
IF(M4D2.NE.10)STOP '?88165B1'
M4D2=20
FIND M4 VIA CURRENT F1M4 USING M4D1,M4D2. !FROM SET PREV
IF(ERSTAT.NE.0)STOP '?88166B1'
GET M4.
IF(M4D1.NE.2000)STOP '?88167B1'
IF(M4D2.NE.20)STOP '?88168B1'
FIND M4 VIA CURRENT O1M4 USING M4D1,M4D2 SUPPRESS SET.
IF(ERSTAT.NE.0)STOP '?88169B1'
IF(ERDATA.NE.2)STOP '?88170B1'
GET M4.
IF(M4D1.NE.2000)STOP '?88171B1'
IF(M4D2.NE.30)STOP '?88172B1'
FIND M4 VIA CURRENT F1M4 USING M4D1,M4D2.
IF(ERSTAT.NE.307)STOP '?88173B1'
CALL FINS6('M4','O1M4')
IF(ERSTAT.NE.0)STOP '?88174B1'
1057 M4D1=1000
M4D2=30
FIND M4 VIA CURRENT O1M4 USING M4D1. !1 KEY DEFS FND 3
IF(ERSTAT.NE.307)STOP '?88175B1'
FIND OWNER O1M4 SET.
IF(ERSTAT.NE.0)STOP '?88176B1'
FIND OWNER F1M4 SET.
IF(ERSTAT.NE.0)STOP '?88177B1'
FIND M4 VIA CURRENT O1M4 USING M4D1.
IF(ERSTAT.NE.0)STOP '?88178B1'
GET.
IF(M4D1.NE.1000)STOP '?88179B1'
IF(M4D2.NE.10)STOP '?88180B1'
FIND M4 VIA CURRENT F1M4 USING M4D1.
IF(ERSTAT.NE.0)STOP '?88181B1'
GET.
IF(M4D1.NE.1000)STOP '?88182B1'
IF(M4D2.NE.20)STOP '?88183B1'
C CLEANUP
1058 FIND OWNER O1M4 SET.
IF(ERSTAT.NE.0)STOP '?88184B1'
DELETE MEMBERS FROM O1M3.
FIND FIRST RECORD OF O1M4 SET.
IF(ERSTAT.NE.0)STOP '?88185B1'
REMOVE FROM ALL.
DELETE.
FIND NEXT RECORD OF O1M4 SET.
IF(ERSTAT.NE.0)STOP '?88186B1'
REMOVE M4 FROM ALL.
DELETE M4.
FIND NEXT RECORD OF F1M4 SET.
IF(ERSTAT.NE.0)STOP '?88187B1'
REMOVE M4 FROM ALL SETS.
DELETE.
FIND NEXT RECORD OF F1M4 SET.
IF(ERSTAT.NE.0)STOP '?88188B1'
REMOVE M4 FROM F1M4.
DELETE.
FIND NEXT RECORD OF O1M4 SET.
IF(ERSTAT.NE.0)STOP '?88189B1'
REMOVE M4 FROM O1M4.
DELETE.
1059 O1C=23
FIND O1.
IF(ERSTAT.NE.0)STOP '?88190B1'
FIND NEXT RECORD OF F1M4 SET.
IF(ERSTAT.NE.0)STOP '?88191B1'
REMOVE FROM O1M4,F1M4.
DELETE.
FIND NEXT RECORD OF O1M4 SET.
IF(ERSTAT.NE.0)STOP '?88192B1'
REMOVE M4 FROM ALL SETS.
DELETE.
FIND NEXT RECORD OF O1M4 SET.
IF(ERSTAT.NE.0)STOP '?88193B1'
REMOVE M4 FROM F1M4,O1M4.
DELETE.
FIND LAST RECORD OF O1M4 SET.
IF(ERSTAT.NE.0)STOP '?88214B1'
REMOVE M4 FROM ALL.
DELETE.
FIND LAST M4 RECORD OF TESTA1 AREA.
IF(ERSTAT.NE.0)STOP '?88215B1'
DELETE.
FIND OWNER OF O1M4 SET.
IF(ERSTAT.NE.0)STOP '?88216B1'
DELETE MEMBERS FROM O1M3.
C ****************************************************
C * DELETES, HANDLED FROM SUBS WITH 2ND SUB-SCHEMA *
C * TRIVIAL CASE DONE THROUGHOUT MAIN PROGRAM *
C ****************************************************
CALL DTVRB2 !INIT
CALL DELCAS(1) !DELETE RECORD THEN DELETE ALL
CALL DELCAS(2) !DELETE SELECTIVE
CALL DELCAS(3) !DELETE RECORD ONLY
CALL DELCAS(4) !DELETE MEMBERS
C MAKE SURE ORIG SUB-SCHEMA NOT AFFECTED
O1C=10
FIND O1 RECORD.
IF(ERSTAT.NE.0)STOP '?88132B1'
GET O1 O1D1.
DELETE ALL.
CALL DELCAS(5) !DELETE RECORD ALL MEMBERS
CALL DELCAS(6) !DELETE RECORD SELECTIVE MEMBERS
OPEN TRANSACTION TUA1.
FIND NEXT DUPLICATE WITHIN O1 RECORD.
IF(ERSTAT.NE.0)STOP '?88292B1'
DELETE ALL.
CLOSE TRANSACTION.
CALL DELCAS(7) !DELETE RECORD ONLY MEMBERS
CALL DELCAS(8) !DELETE RECORD SELECTIVE MEMBERS SET
CALL DELCAS(9) !DELETE RECORD ONLY MEMBERS SET1,SET2
CALL DELCAS(10) !CLOSE AREA
O1C=23
FIND O1.
IF(ERSTAT.NE.0)STOP '?88293B1'
DELETE MEMBERS.
DELETE O1.
99 CLOSE AREA TESTA1.
CLOSE JOURNAL.
CALL STATS
TYPE 9992
9992 FORMAT(' [Completed basic DML tests]')
* DBMS
END DTVRB1.
SUBROUTINE EUMR1
* DBMS
ACCESS SUB-SCHEMA DTSSV1 OF SCHEMA DTVRB
PRIVACY KEY COMPILE BOGUS.
CALL EUMR(ERSTAT)
RETURN
*DBMS
END EUMR1.
SUBROUTINE EUMR2
* DBMS
ACCESS SUB-SCHEMA DTSSV2 OF SCHEMA DTVRB
PRIVACY KEY COMPILE B2.
CALL EUMR(ERSTAT)
RETURN
*DBMS
END EUMR2.
SUBROUTINE EUMR(ERSTAT)
C PROCESS ALL UMR (**09) EXCEPTIONS
INTEGER ERSTAT
COMMON IER,IGN
IF((ERSTAT-((ERSTAT/100)*100)).NE.9)GO TO 2020
IF(ERSTAT.NE.209 .AND. ERSTAT.NE.809)GO TO 2030
IF(IGN.NE.209 .AND. IGN.NE.809)GO TO 2040
IER=ERSTAT
RETURN
2020 TYPE 2025,ERSTAT
2025 FORMAT(' ?TRAPPING EXCEPTION **09, RECEIVED ',I5)
STOP
2030 TYPE 2035,ERSTAT
2035 FORMAT(' ?EXPECTING EXCEPTION 0209 OR 0809, RECEIVED ',I5)
STOP
2040 TYPE 2045,ERSTAT
2045 FORMAT(' ?UNEXPECTED EXCEPTION ',I5)
STOP
* DBMS
END EUMR.
SUBROUTINE EEON1
* DBMS
ACCESS SUB-SCHEMA DTSSV1 OF SCHEMA DTVRB
PRIVACY KEY FOR COMPILE IS BOGUS.
CALL EEON(ERSTAT)
RETURN
* DBMS
END EEON1.
SUBROUTINE EEON2
* DBMS
ACCESS SUB-SCHEMA DTSSV2 OF SCHEMA DTVRB
PRIVACY KEY FOR COMPILE IS B2.
CALL EEON(ERSTAT)
RETURN
* DBMS
END EEON2.
SUBROUTINE EEON(ERSTAT)
C PROCESS ESA (0307) AND NRS (0326) ONLY
INTEGER ERSTAT
COMMON IER,IGN
IF(ERSTAT.NE.307 .AND. ERSTAT.NE.326)GO TO 3020
IF(IGN.NE.0 .AND. IGN.NE.ERSTAT)GO TO 3030
IER=ERSTAT
RETURN
3020 TYPE 3025,ERSTAT
3025 FORMAT(' ?TRAPPING EXCEPTION 307 OR 326, RECEIVED ',I5)
STOP
3030 TYPE 3035,ERSTAT
3035 FORMAT(' ?UNEXPECTED EXCEPTION ',I5)
STOP
* DBMS
END EEON.
SUBROUTINE EDEL1
* DBMS
ACCESS SUB-SCHEMA DTSSV1 OF DTVRB.
CALL EDEL(ERSTAT)
RETURN
* DBMS
END EDEL1.
SUBROUTINE EDEL2
* DBMS
ACCESS SUB-SCHEMA DTSSV2 OF DTVRB PRIVACY KEY COMPILE B2.
CALL EDEL(ERSTAT)
RETURN
* DBMS
END EDEL2.
SUBROUTINE EDEL(ERSTAT)
C PROCESS ANY DELETE VERB (02**) ERROR
INTEGER ERSTAT
COMMON IER,IGN
IF(ERSTAT.LT.200 .OR. ERSTAT.GT.299)GO TO 4020
IF(ERSTAT.NE.230)GO TO 4030
IF(ERSTAT.NE.IGN)GO TO 4040
IER=230
RETURN
4020 TYPE 4025,ERSTAT
4025 FORMAT(' ?TRAPPING EXCEPTION 02**, RECEIVED ',I5)
STOP
4030 TYPE 4035,ERSTAT
4035 FORMAT(' ?EXPECTING EXCEPTION 0230, RECEIVED ',I5)
STOP
4040 TYPE 4045
4045 FORMAT(' ?UNEXPECTED EXCEPTION 0230')
STOP
* DBMS
END EDEL.
SUBROUTINE EGEN1
* DBMS
ACCESS DTSSV1 OF SCHEMA DTVRB.
CALL EGEN(ERSTAT)
RETURN
* DBMS
END EGEN1.
SUBROUTINE EGEN2
* DBMS
ACCESS DTSSV2 OF SCHEMA DTVRB PRIVACY KEY COMPILE B2.
CALL EGEN(ERSTAT)
RETURN
* DBMS
END EGEN2.
SUBROUTINE EGEN(ERSTAT)
C HANDLE ALL EXCEPS NOT HANDLED ABOVE
INTEGER ERSTAT
COMMON IER,IGN
IF(ERSTAT.NE.IGN)GO TO 5020
IER=ERSTAT
RETURN
5020 TYPE 5025,ERSTAT
5025 FORMAT(' ?UNEXPECTED EXCEPTION ',I5)
STOP
* DBMS
END EGEN.