Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

*	Program DTVRB2 - Basic DML Verb Test Sub-Program
*	(offshoot of BAS01C.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	SUBROUTINE DTVRB2 - DELETE MANIPS - 2ND SUB-SCHEMA
C	PART OF LARGE DML TEST, MAIN PROGRAM DTVRB1.FML
C	USED TO TEST DML VERB PROCESSORS, AND DBCS IN GENERAL
C	  SEE DTVRB FOR LAST UNIQUE ERROR NUMBER

	SUBROUTINE DTVRB2

	COMMON IER,IGN

C	******************************************
C	*  FULL BLOWN INVOKE, SECOND SUB-SCHEMA  *
C	******************************************

*	DBMS
	INVOKE SUB-SCHEMA DTSSV2 OF SCHEMA DTVRB PRIVACY KEY
		FOR COMPILE B2.

C	SAME USE PROCS AS MAIN PROG
*DBMS
	USE EEON2 IF ERROR-STATUS IS 0307,0326. ! FIND ESA, NRS
*DBMS
	USE EUMR2 IF ERSTAT 0009. !ANY UMR
* DBMS
	USE EDEL2 IF ERSTAT 0200. !ANY DELETE EXCEP
*DBMS
	USE EGEN2 IF ERROR-STATUS. !ANY EXCEP NOT CASED ABOVE

	!INIT CASE, INVOKE, USE PROC SETUP, OPEN, 1ST REC
6100	CALL JMNAME('DSK:DTVRB.JRN')
	OPEN AREA TESTA2 USAGE-MODE UPDATE.
	P1AREA(1)='TESTA'
	P1AREA(2)='2'
	P1AREA(3)=0
	STORE P1.
	GO TO 6900

C	*************************************************
C	*  DELETES, ALL NON TRIVIAL FORMS               *
C	*  USE COMMON SUBROUTINES FOR SETUP AND CHECKS  *
C	*************************************************
	ENTRY DELCAS(ICASE)

6200	IF(ICASE.LT.1 .OR. ICASE.GT.10)GO TO 6950
	CALL SETDB('DTSSV2')
	GO TO (6210,6220,6230,6240,6250,6260,6270,6280,6290,
	1 6300),ICASE

	!DELETE SPECIFIC RECORD, THEN ALL
6210	CALL DELINI
	IGN=230
	DELETE DL1.
	IF (ERSTAT.NE.230) STOP '?8846B1'
	IF(IER.NE.230)STOP '?88133B1'
	IGN=0
	DELETE DL1 ALL.
	CALL DELCHK(0)				!NOTHING LEFT
	GO TO 6900

	!DELETE SELECTIVE
6220	CALL DELINI
	DELETE  SELECTIVE.
	CALL DELCHK(5)
	GO TO 6900

	!DELETE RECORD ONLY
6230	CALL DELINI
	DELETE DL1 ONLY.
	CALL DELCHK(12)
	GO TO 6900

	!DELETE MEMBERS (WILL FAIL) THEN ADD SET
6240	CALL DELINI
	IGN=230
	DELETE MEMBERS.
	IF (ERSTAT.NE.230) STOP '?88234B1'
	IF(IER.NE.230)STOP '?88235B1'
	IGN=0
	DELETE MEMBERS FROM L12MAN2.
	CALL DELCHK(17)
	GO TO 6900

	!DELETE RECORD ALL MEMBERS
6250	CALL DELINI
	DELETE DL1 ALL MEMBERS.
	CALL DELCHK(1)
	GO TO 6900

	!DELETE RECORD SELECTIVE MEMBERS
6260	CALL DELINI
	DELETE DL1 SELECTIVE MEMBERS.
	CALL DELCHK(2)
	GO TO 6900

	!DELETE ONLY MEMBERS FROM SET
6270	CALL DELINI
	DELETE ONLY MEMBERS FROM L12MAND.
	CALL DELCHK(15)
	GO TO 6900

	!DELETE RECORD SELECTIVE MEMBERS SET
6280	CALL DELINI
	DELETE DL1 SELECTIVE MEMBERS FROM L12OPT.
	CALL DELCHK(11)
	GO TO 6900

	!DELETE ONLY MEMBERS SET1,SET2
6290	CALL DELINI
	DELETE ONLY MEMBERS FROM L12MAND,L12OPT.
	CALL DELCHK(9)
	GO TO 6900

	!CLOSE
6300	CLOSE AREA TESTA2.
	CLOSE JOURNAL.
	GO TO 6900

6900	CALL UNSET
6950	RETURN
*DBMS
	END  DTVRB2.

	SUBROUTINE DELINI
C	BUILD THREE LEVEL STRUCTURE TO BE DELETED
	ACCESS DTSSV2 OF DTVRB PRIVACY KEY COMPILE B2.

	OPEN TRANSACTION TUA2.
	STORE DL1.
	STORE DL2MAN2.
	STORE DL2MAND.
	  STORE DL3OPT SUPPRESS ALL.		!FORCE OWNER LINK TO BE USED ON NEXT STORE
	  FIND DL3OPT.				!CHANGE CURR OF SET...WITH NON-SET OPER SO THAT
	IF(ERSTAT.NE.0)STOP '?88134B1'
						!APPLIC OF ORDER PRIOR CLAUSE WILL USE OWNER PTR
	  STORE DL3OPT.				!...RATHER THAN OB.COWN
	  INSERT INTO P1L3.
	  STORE DL3MAN2.
	STORE DL2MAN2.
	STORE DL2MAND.
	  STORE DL3OPT.
	  STORE DL3MAN2.
	  STORE DL3OPT.
	STORE DL2OPT.
	  STORE DL3OPT2.
	  STORE DL3MAND.
	  STORE DL3MAND.
	STORE DL2OPT.
	INSERT DL2OPT INTO ALL SETS.
	  STORE DL3MAND.
	  STORE DL3MAND.
	  STORE DL3OPT2.
	FIND FIRST DL1 RECORD OF TESTA2 AREA.		!SO DELETE WILL APPLY TO RIGHT RECORD
	IF(ERSTAT.NE.0)STOP '?88135B1'
	CLOSE TRANSACTION.
	RETURN
*	DBMS
	END DELINI.

	SUBROUTINE DELCHK(LEFT)
C	COUNT RECS (EXCEPT P1) IN AREA AFTER DELETE
	ACCESS DTSSV2 OF DTVRB PRIVACY KEY COMPILE B2.
	FIND FIRST RECORD OF TESTA2 AREA.
	IF(ERSTAT.NE.0)STOP '?88136B1'

	OPEN TRANSACTION TRCA2.
	I=0
10	FIND NEXT RECORD OF TESTA2 AREA.
	IF (ERSTAT.NE.0) GOTO 11
	I=I+1
	GO TO 10
11	IF (ERSTAT.NE.307) STOP '?8850B1'
	IF (I.NE.LEFT) STOP '?8851B1'
	CLOSE TRANSACTION TRCA2.

	!!! NOW RE-INIT ENVIR
	FIND FIRST RECORD OF TESTA2 AREA.
	IF(ERSTAT.NE.0)STOP '?88137B1'
12	FIND NEXT RECORD OF TESTA2 AREA.
	IF (ERSTAT.EQ.307) GOTO 13
	IF (ERSTAT.NE.0) STOP '?8852B1'
	DELETE ALL.
	GOTO 12
13	RETURN
*	DBMS
	END DELCHK.