!	DBMS20.CMP	for DBMS-20 Version 6.1		Jun-84

!                     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.

!	Comprehensive test of DBMS-20 using UETP
!	Timings: Approx 10 min CPU, 45 min connect.

@DEFINE UTP: PS:<UETP.LIB>
@DEFINE DSK: PS:<UETP.DBMS>,UTP:



BEGIN::

! Files needed in the UETP area:

!	DBMS20.CMP	This file
!	DTORD.DDL	General Schema and test
!	DTORDR.CBL
!	DTORDR.FML
!	DTSCH.DDL	Schema and DML bind processor tests
!	DTSCHB.CBL
!	DTSCHB.FML
!	DTVRB.DDL	DML verb processor and DBCS tests
!	DTVR1S.CBL	Large subset of DTVRB1.CBL
!	DTVRB1.CBL
!	DTVRB2.CBL
!	DTVRB1.FML
!	DTVRB2.FML

@DEFINE JRN: DSK:


@RUN UTP:SENDER
*TYPE START
*BLABEL BEGIN:
*TEST DBMS20
*SEND Start of DBMS test.
*EXIT

!	Clean up area
!	Running in a controlled environment, so wildcards allowed.
@NOERROR
@DELETE DSK:*.*
@EXPUNGE DSK:
@ERROR



TSTCK::
!	Check for required test files.
@ERROR %
@DIRECT UTP:DTORD.DDL,UTP:DTORDR.CBL,UTP:DTORDR.FML
@IF (ERROR) @GOTO TSTF1
@DIRECT UTP:DTSCH.DDL,UTP:DTSCHB.CBL,UTP:DTSCHB.FML
@IF (ERROR) @GOTO TSTF1
@DIRECT UTP:DTVRB.DDL,UTP:DTVRB1.CBL,UTP:DTVRB2.CBL,UTP:DTVR1S.CBL
@IF (ERROR) @GOTO TSTF1
@DIRECT UTP:DTVRB1.FML,UTP:DTVRB2.FML
@IF (ERROR) @GOTO TSTF1
@ERROR
@GOTO UTLCK

TSTF1::
@ERROR
@RUN UTP:SENDER
*TEST DBMS20
*TYPE ERROR
*BLABEL TSTCK:
*SEND DBMS test files are missing from PS:<UETP.LIB>. Test aborted.
*EXIT
@GOTO ENDIT



UTLCK::
!	Check for all required DBMS utilities.
!	Assume that everything is OK
@COPY NUL: DSK:DTUTL.OK

@GET SYS:DBINFO
@IF (ERROR) @GOTO UTLF1
@INFORMATION VERSION
@GET SYS:DBMEND
@IF (ERROR) @GOTO UTLF1
@INFORMATION VERSION
@GET SYS:FORDML
@IF (ERROR) @GOTO UTLF1
@INFORMATION VERSION
@GET SYS:SCHEMA
@IF (ERROR) @GOTO UTLF1
@INFORMATION VERSION
@GET SYS:XDML
@IF (ERROR) @GOTO UTLF1
@INFORMATION VERSION
@GOTO SCHRN

UTLF1::
@RUN UTP:SENDER
*TEST DBMS20
*TYPE ERROR
*BLABEL UTLCK:
*SEND One of the DBMS utilities; SYS:DBINFO.EXE, SYS:DBMEND.EXE,
*SEND SYS:FORDML.EXE, SYS:SCHEMA.EXE, or SYS:XDML.EXE is missing.
*SEND Test aborted.
*EXIT
@GOTO ENDIT



SCHRN::
!	Now copy the DDLs and run SCHEMA
@ERROR
@COPY UTP:DTORD.DDL,UTP:DTSCH.DDL,UTP:DTVRB.DDL DSK:
@ERROR %
@RUN SYS:SCHEMA
*DTORD=DTORD.DDL
@IF (ERROR) @GOTO SCHF1
*DTSCH/NOCR
@IF (ERROR) @GOTO SCHF1
!	Two warnings are expected in next schema
@ERROR
*DTVRB.DDL
@IF (ERROR) @GOTO SCHF1
*^Z
!	Now copy the database files and lock files
!	for repeated executions using fresh copies
@COPY DSK:DTORD.LOK DSK:DTORD.LOC
@COPY DSK:DTORD1.DBS DSK:DTORD1.DBC
@COPY DSK:DTORD2.DBS DSK:DTORD2.DBC
@COPY DSK:DTORD3.DBS DSK:DTORD3.DBC
@COPY DSK:DTORD4.DBS DSK:DTORD4.DBC
@COPY DSK:DTSCH.LOK DSK:DTSCH.LOC
@COPY DSK:DTVRB.LOK DSK:DTVRB.LOC
@COPY DSK:DTVRB1.DBS DSK:DTVRB1.DBC
@COPY DSK:DTVRB2.DBS DSK:DTVRB2.DBC
@GOTO FMLRN

SCHF1::
@ERROR
@RESET
@RUN UTP:SENDER
*TEST DBMS20
*TYPE ERROR
*BLABEL SCHCK:
*SEND SCHEMA test produced fatal errors. Test aborted.
*EXIT
@GOTO ENDIT



FMLRN::
!	Do the FORTRAN DML translations, even if no FORTRAN
@ERROR %
@RUN SYS:FORDML
*DTORDR=DTORDR.FML/CHARACTER
@IF (ERROR) @GOTO FMLF1
*DTSCHB.FML/NOCH
@IF (ERROR) @GOTO FMLF1
*DTVRB1/NOCHAR/UNFLAG
@IF (ERROR) @GOTO FMLF1
*DTVRB2/NOCH/U
@IF (ERROR) @GOTO FMLF1
*^Z
@GOTO XDMRN

FMLF1::
@ERROR
@RESET
@RUN UTP:SENDER
*TYPE ERROR
*BLABEL FMLCK:
*TEST DBMS20
*SEND FORDML test produced fatal errors.
*EXIT
@NOERROR
@DELETE DSK:DTUTL.OK,
@EXPUNGE
@




XDMRN::

!	Use XDML to create a sample Order Entry database
!	Combined with this are a few miscellaneous commands
@ERROR
@RUN SYS:XDML
@ERROR %
*INVOKE SUB-SCHEMA DTSSOC OF SCHEMA DTORD
*ORDER
*OPEN ALL USAGE-MODE UPDATE
*SHOW DATABASE
*DAYTIME
*ACCEPT IDAREA
*CUSAREA
*ACCEPT ORDSUM
*1
*
*0
*STORE ORDSUM
*ACCEPT PROD
*KA10
*CENTRAL PROCESSOR
*140000
*0
*0
*0
*0
*0
*0
*STORE PROD
*DISPLAY
*ACCEPT PROD
*DF10
*DATA CHANNEL
*14000
*0
*0
*0
*0
*0
*0
*STORE PROD
*ACCEPT SLSENG
*HOGAN, R.
*MAYNARD
*617897-5112968
*
*STORE SLSENG
*ACCEPT SLSENG
*CARMICHAEL, R.
*SANTA ANNA
*714979-2460   2
*
*STORE SLSENG
*ACCEPT CUSTOM
*DEC
*0
*
*ACCEPT STREET
*146 MAIN ST.
*ACCEPT CITY
*MAYNARD
*ACCEPT STATE
*MASS.
*ACCEPT ZIP
*01754
*STORE CUSTOM
*ACCEPT SLSENG-NAME
*HOGAN, R.
*FIND SLSENG
*FIND CUSTOM
*INSERT CUSTOM INTO SLSCUS-SET
*ACCEPT PURORD
*1
*071173
*0
*0
*
*STORE PURORD
*ACCEPT ORDSUM
*2
*
*1
*ACCEPT ITEM
*1001
*KA10
*1
*140000
*
*ACCEPT PROD-NO
*KA10
*FIND PROD RECORD
*ACCEPT PROD-ON-ORDER
*1
*MODIFY PROD PROD-ON-ORDER
*STORE ITEM
*FIND PURORD
*ACCEPT PURORD
*
*
*1
*140000
*
*MODIFY PURORD
*FIND FIRST ORDSUM RECORD OF ORDAREA AREA
*MODIFY ORDSUM ORDSUM-ORDERS,ORDSUM-NO
*CLOSE RUN-UNIT
*SHOW DATABASE
*STATS
*EXIT
@IF (ERROR) @GOTO XDMF1

XDMR2::
!	Demonstrate many of the capabilities of XDML
!	First, create a sample take file
@ERROR
@COPY TTY: DTXDM.CMD
@TYPE RUNNING XDML
@^Z
@ERROR
@RUN SYS:XDML
@ERROR %
*LOG OUTPUT DTXDM
*TAKE DTXDM
*SET ECHO TAKE ON
*TAKE DTXDM.CMD
*INVOKE SUB DTSSOC SCHEMA DTORD
*ORDER
*OPEN ALL
*FIND FIRST ORDSUM RECORD OF ORDAREA AREA
*NOTE ALL
*SET DISPLAY ERROR STATUS OFF
*FIND NEXT ORDSUM RECORD OF ORDAREA AREA
@IF (ERROR) @GOTO XDMF1
*TRANSLATE
@IF (NOERROR) @GOTO XDMF1
*SET DISPLAY ERROR STATUS ON
*DEFINE FN
*TYPE NEXT REC OF CUSAREA IS:
*FETCH NEXT RECORD OF CUSAREA AREA
*END
*SHOW USER-DEFINED-COMMAND FN
*FIND FIRST REC OF CUSAREA A
*SET DISPLAY CURRENCY ON
*FN
*SHOW CURRENCY
*MOVE CURRENCY STATUS RUN-UNIT TO DATA-BASE-KEY
*DISPLAY DATA-BASE-KEY
*SET DBKEY FORMAT SINGLE
*SET DBKEY RADIX OCTAL
*DISPLAY DATA-BASE-KEY
*GET
*DISPLAY
@IF (ERROR) @GOTO XDMF1
!	2ndary command level manips
*ENABLE
*DTKEY
*INTERCEPT NONE
*SHOW MODE
*RESET INTERCEPTS
*RESET NOTES
*SHOW BUFFER CUSAREA
*SHO LOC CUST-NAME
*DDT
*RET^[X
*QUIT
@CONTINUE
@IF (ERROR) @GOTO XDMF1
!	User command/ keypad manips
*ASSIGN FN ONE
*SHOW KEYPAD
*PRESERVE DTXDM
*DEASSIGN ONE
*UNDEFINE FN
*DECLARE DTXDM
*SET ECHO USER ON
*FN
*LOG NO OUTPUT
*PUSH
@DIRECT DTXDM.LOG
@IF (ERROR) @GOTO XDMF1
@DELETE DTXDM.CMD,DTXDM.DCA,DTXDM.LOG,
@EXPUNGE
@
@POP
*SHOW KEYPAD
*SHOW MODE
*CLOSE
*EXIT
@IF (NOERROR) @GOTO INFRN

XDMF1::
@ERROR
@RESET
@RUN UTP:SENDER
*TEST DBMS20
*TYPE ERROR
*BLABEL XDMCK:
*SEND XDML tests produced fatal errors.
*EXIT
@NOERROR
@DELETE DSK:DTUTL.OK,
@EXPUNGE
@



INFRN::
!	Use DBINFO to examine the Order Entry database
@ERROR %
@RUN SYS:DBINFO
*SCHEMA DTORD
*SS
*ADMIN:DTKEY
*OPEN CUSAREA,PRDAREA,SYSAREA,ORDAREA
*SUPERSEDE DTORD
*DISPLAY CALC
*DISP CREF
*DIS MAP
*STAR:20
*DISP FREE:1
*NOSTAR
*ACCUMULATE:2
*DISPLAY USAGE
*NOACCUMULATE
*DISPLAY US:"PROD-ITEM-SET"
*PAGES 5-10
*DISP DATA
*NOPAGES
*D D:"ALLORD-SET"
*DISPLAY
*DISPLAY K:7001
*APPEND DTORD
*DIS
*RECORD:33
*DISPLAY DATA:"CUSORD-SET"
*CLOSE ALL
*STATS
*EXIT
@IF (ERROR) @GOTO INFF1
@DIRECT DTORD.DBI
@IF (NOERROR) @GOTO MNDRN

INFF1::
@ERROR
@RESET
@RUN UTP:SENDER
*TEST DBMS20
*TYPE ERROR
*BLABEL INFCK:
*SEND DBINFO tests produced fatal errors.
*EXIT
@NOERROR
@DELETE DSK:DTUTL.OK,
@EXPUNGE
@



MNDRN::
!	Use DBMEND to manipulate and abstract the journal
!	And merge in before images for most areas
@ERROR %
@RUN SYS:DBMEND
*JOURNAL DTORD
*LABEL
*DISPLAY BEFORE COMMAND PAGENUM TEXT TRANSACTION
*START
*END
*ABSTRACT DTORD
*BUILD DTORDB
*CLOSE JOURNAL
*SCHEMA DTORD
*JOURNAL DTORD
*EXCLUDE SYSAREA
*OPEN ALL:DTKEY
*START
*END
*TRACE
*MERGE BEFORE
*CLOSE RUN-UNIT
*EXIT
@IF (ERROR) @GOTO MNDF1
@DIRECT DTORD.ABS
@IF (ERROR) @GOTO MNDF1
@DIRECT DTORDB.ABS
@IF (ERROR) @GOTO MNDF1

!	Use XDML to make sure there is no data
@ERROR
@RUN SYS:XDML
@ERROR %
*INVOKE SUB-SCHEMA DTSSOC OF SCHEMA DTORD
*ORDER
*OPEN ALL
*FIND FIRST ORDSUM RECORD OF ORDAREA AREA
@IF (NOERROR) @GOTO MNDF1
*CLOSE ALL
*EXIT
@IF (ERROR) @GOTO MNDF1

!	Use DBMEND to merge in all original after images
!	 and use XDML to check for existance of data
@RUN SYS:DBMEND
*JOURNAL DTORD
*EXCLUDE SYSAREA
*FORCEOPEN ALL
*START
*END *:21
*TRACE
*MERGE AFTER
*CLOSE RUN-UNIT
*EXIT
@IF (ERROR) @GOTO MNDF1

!	Now to verify
@ERROR
@RUN SYS:XDML
@ERROR %
*INVOKE SUB-SCHEMA DTSSOC SCHEMA DTORD
*ORDER
*OPEN ALL
*ACCEPT IDAREA
*CUSAREA
*FETCH FIRST ORDSUM RECORD OF ORDAREA AREA
*ACCEPT PROD-NO
*KA10
*FETCH PROD
*ACCEPT PROD-NO
*DF10
*FETCH PROD
*FETCH FIRST SLSENG RECORD OF CUSAREA AREA
*FETCH NEXT SLSENG REC CUSAREA A
*ACCEPT CUST-NAME
*DEC
*FETCH CUSTOM
*ACCEPT ORDNUM
*1
*FETCH PURORD
*FETCH FIRST ITEM REC OF ORDITM-SET SET
*CLO ALL
*EXI
@IF (ERROR) @GOTO MNDF1

!	Use XDML to open a transaction, abort, and reset, use DBMEND to
!	delete the transaction, and use XDML to check
@ERROR
@RUN SYS:XDML
@ERROR %
*INV SUB DTSSOC SCH DTORD
*ORDER
*OPEN ALL U U
*OPEN TRANSACTION
*JRTEXT BIG TRANSACTION
*ACC IDAREA
*CUSAREA
*ACC CUSTOM
*DEC-WEST
*
*OREGON
*STORE CUSTOM
*FETCH FIRST REC CUSAREA AREA
*MODIFY CUSTOM CUST-KEY
*DEFINE FN
*FETCH NEXT REC CUSAREA AREA
*END
*FN
*MODIFY SLSENG SLSENG-PAD
*FN
*MODIFY CUSTOM CUST-KEY
*FN
*MODIFY SLSENG SLSENG-PAD
*FETCH FIRST REC CUSAREA AREA

!	Generate an illegal-area intercept
*ACCEPT IDAREA
*BOGUS
@IF (ERROR) @GOTO MNDF1
*STORE CUSTOM
@IF (NOERROR) @GOTO MNDF1
@RESET

@RUN SYS:DBMEND
*SCHEMA DTORD
*DELETE TRANSACTION
*EXIT
@IF (ERROR) @GOTO MNDF1

@ERROR
@RUN SYS:XDML
@ERROR %
*INV SUB DTSSOC SCH DTORD
*ORDER
*OPEN ALL
*ACC IDAREA
*CUSAREA
*ACCEPT CUST-NAME
*DEC-WEST
*FIND CUSTOM RECORD
@IF (NOERROR) @GOTO MNDF1
*CLO ALL
*EXIT
@IF (ERROR) @GOTO MNDF1

!	Now Set AID for all areas
@RUN SYS:DBMEND
*SCHEMA DTORD
*AID ALL
*EXIT

!	And add a record, then verify its not there
!	when all areas are temporary
@ERROR
@RUN SYS:XDML
@ERROR %
*INVOKE SUB DTSSOC SCHEMA DTORD
*ORDER
*OPEN ALL USAGE-MODE EXCLUSIVE UPDATE
*ACC IDAREA
*CUSAREA
*ACC CUSTOM
*DEC-WEST
*
*OREGON
*STORE CUSTOM SUPPRESS ALL
*CLOSE RUN
*EXIT
@IF (ERROR) @GOTO MNDF1

@ERROR
@RUN SYS:XDML
@ERROR %
*INVOKE SUB TS1 OF SCH DTORD
*OTEMP
*OPEN ALL
*ACCEPT CUST-NAME
*DEC-WEST
*ACCEPT IDAREA
*CUSAREA
*FIND CUSTOM RECORD
@IF (NOERROR) @GO TO MNDF1
*CLOSE ALL
*EXIT
@IF (ERROR) @GO TO MNDF1

!	Now MERGE AID, turn it off, and verify data is there
@RUN SYS:DBMEND
*SCHEMA DTORD
*OPEN ALL
*MERGE AID
*CLOSE CUSAREA,PRDAREA,SYSAREA,ORDAREA
*EXIT
@IF (ERROR) @GOTO MNDF1

!	Record should be there even when temp
@ERROR
@RUN SYS:XDML
@ERROR %
*INVOKE SUB TS1 OF SCH DTORD
*OTEMP
*OPEN ALL
*ACCEPT CUST-NAME
*DEC-WEST
*ACCEPT IDAREA
*CUSAREA
*FIND CUSTOM RECORD
@IF (ERROR) @GOTO MNDF1
*CLOSE ALL
*EXIT
@IF (ERROR) @GOTO MNDF1
@RESET
@GOTO UTLDN

MNDF1::
@ERROR
@RESET
@RUN UTP:SENDER
*TEST DBMS20
*TYPE ERROR
*BLABEL MNDCK:
*SEND DBMEND tests produced fatal errors.
*EXIT
@NOERROR
@DELETE DSK:DTUTL.OK,
@EXPUNGE
@



UTLDN::
!	Utility tests complete - give status
@ERROR %
@DIRECT DSK:DTUTL.OK
@IF (ERROR) @GOTO UTLD2
@ERROR
@RUN UTP:SENDER
*TEST DBMS20
*TYPE MAJOR
*BLABEL UTLDN:
*SEND All DBMS utility tests completed OK.
*EXIT
@GOTO HSTTS

UTLD2::
@ERROR
@RUN UTP:SENDER
*TEST DBMS20
*TYPE ERROR
*BLABEL UTLDN:
*SEND Some DBMS utility tests failed.
*EXIT



HSTTS::
!	Should minimally have a DBMS.REL in SYS:. Will check for
!	possibly required DBMSF.REL with FORTRAN check later.
!	Let test proceed, and catch error at load time.
@ERROR %
@DIRECT SYS:DBMS.REL
@IF (NOERROR) @GOTO COBTS
@ERROR
@RUN UTP:SENDER
*TEST DBMS20
*TYPE MAJOR
*BLABEL DBLCK:
*SEND DBMS load library SYS:DBMS.REL not found.
*EXIT



COBTS::
!	Check for the FORTRAN and COBOL host languages
!	First try COBOL
@ERROR %
@DIRECT SYS:COBOL.EXE
@IF (NOERROR) @GOTO COBRN
@RUN UTP:SENDER
*TYPE MAJOR
*BLABEL COBTS:
*TEST DBMS20
*SEND COBOL host language unavailable, trying FORTRAN.
*EXIT
@GOTO FORTS


COBRN::
!	Now wish to try all flavors of COBOL - at least 1 should work
!	if DBMS has been installed with COBOL.
!	Will try COBOL, CBL74, and CBL68 (via COMPILE switches)
!	However COBOL may actually be one of CBL68 or 74, therfore will
!	also check one of the generated .RELs to avoid replication

!	First, get clean DTORD database files and no .JRN
@NOERROR
@RESET
@DELETE DSK:DTORD.LOK,DSK:DTORD1.DBS,DSK:DTORD2.DBS,DSK:DTORD3.DBS
@DELETE DSK:DTORD4.DBS,DSK:DTORD.JRN
@EXPUNGE DSK:
@ERROR
@COPY DSK:DTORD.LOC DSK:DTORD.LOK
@COPY DSK:DTORD1.DBC DSK:DTORD1.DBS
@COPY DSK:DTORD2.DBC DSK:DTORD2.DBS
@COPY DSK:DTORD3.DBC DSK:DTORD3.DBS
@COPY DSK:DTORD4.DBC DSK:DTORD4.DBS

!	Now begin with generic COBOL
@ERROR %
@COMPILE DTORDR.CBL
@IF (ERROR) @GOTO COBF1
@COMPILE DTSCHB.CBL
@IF (ERROR) @GOTO COBF1
!	Try and compile full COBOL DML test - may fail
@COMPILE DTVRB1.CBL
@IF (NOERROR) @GOTO COBV2
@NOERROR
@DELETE DSK:DTVRB1.REL,
@EXPUNGE
@
@ERROR %
!	COBOL DML 99% sub-set must compile
@COMPILE DTVR1S.CBL
@IF (ERROR) @GOTO COBF1
!	Simplify loading
@COPY DSK:DTVR1S.REL DSK:DTVRB1.REL
COBV2::
@COMPILE DTVRB2.CBL
@IF (NOERROR) @GOTO COBLD

COBF1::
@ERROR
@RESET
@RUN UTP:SENDER
*TYPE MAJOR
*BLABEL COBCK:
*TEST DBMS20
*SEND Using COBOL: DBMS tests failed to compile.
*EXIT
@GOTO C74CK

COBLD::
@ERROR %
@LOAD DTORDR.REL
@IF (ERROR) @GOTO COBF2
@SAVE DTORDR
@IF (ERROR) @GOTO COBF2
@LOAD DTSCHB.REL
@IF (ERROR) @GOTO COBF2
@SAVE DTSCHB
@IF (ERROR) @GOTO COBF2
@LOAD DTVRB1.REL,DTVRB2.REL
@IF (ERROR) @GOTO COBF2
@SAVE DTVRB1
@IF (NOERROR) @GOTO COBEX

COBF2::
@ERROR
@RESET
@RUN UTP:SENDER
*TYPE MAJOR
*BLABEL COBLD:
*TEST DBMS20
*SEND Using COBOL: DBMS tests failed to load.
*EXIT
@GOTO C74CK

COBEX::
@ERROR %
@RUN DTSCHB
@IF (ERROR) @GOTO COBF3
@ERROR
!	May have a warning if really CBL68 or CBL74
@RUN DTVRB1
@IF (ERROR) @GOTO COBF3
@ERROR %
@RUN DTORDR
*BEGIN
*ENTER
*PROD
*KA10
*CENTRAL PROCESSOR
*140000
*DF10
*DATA CHANNEL
*14000
*KI10
*CENTRAL PROCESSOR
*240000
*
*SLSENG
*HOGAN, R.
*MAYNARD
*617
*897-5111
*2968
*CARMICHAEL, R.
*SANTA ANNA
*714
*979-2460
*2
*BRANDT, D.
*CAMBRIDGE
*617
*491-6130
*2522
*CUTHBERTSON, F.
*CAMBRIDGE
*617
*491-6130
*2522
*
*CUSTOM
*DEC
*146 MAIN ST.
*MAYNARD
*MASS.
*01754
*
*YES
*070973
*KA10
*3
*DF10
*4
*
*CUSTOM
*COPLEY
*2525 PACIFIC BEACH BLVD.
*SAN DIEGO
*CALIF.
*07111
*CARMICHAEL, R.
*YES
*071173
*KA10
*1
*
*CUSTOM
*FIRST CHURCH
*25 HUNTINGTON AVE.
*BOSTON
*MASS.
*02139
*BRANDT, D.
*YES
*071173
*KI10
*1
*DF10
*3
*
*CUSTOM
*SPAN
*25 TURNPIKE ROAD
*PROVIDENCE
*RHODE ISLAND
*01800
*CUTHBERTSON, F.
*NO
*
*INQUIRY
*CUSTOM
*DEC
*YES
*YES
*
*ENTER
*PROD
*MC10
*MEMORY PORT AND CABLE
*1000
*MD10-E
*MD10 32K WORD MEMORY EXPANSION MODULE
*42000
*
*PURORD
*DEC
*071273
*MC10
*2
*
*
*QUIT
@IF (ERROR) @GOTO COBF3
@ERROR
@RUN UTP:SENDER
*TYPE MAJOR
*BLABEL COBEX:
*TEST DBMS20
*SEND Using COBOL: DBMS tests completed OK.
*EXIT
!	Copy simple DTSCHB.REL for comparison
!	And create DTHOST.OK to show 1 successful host run
@COPY DSK:DTSCHB.REL DSK:DTSCHB.COB
@COPY NUL: DSK:DTHOST.OK
@GOTO C74CK

COBF3::
@ERROR
@RESET
@RUN UTP:SENDER
*TYPE MAJOR
*BLABEL COBEX:
*TEST DBMS20
*SEND Using COBOL: DBMS tests failed to execute.
*EXIT


C74CK::
!	Now try CBL74
!	If no SYS:CBL74.EXE, skip all this
@ERROR %
@DIRECT SYS:CBL74.EXE
@IF (ERROR) @GOTO C68CK
!	First, get fresh copy of .LOK and .DBS, and no .JRNs
!	And delete previous .RELs and .EXEs
@NOERROR
@RESET
@DELETE DSK:*.LOK,DSK:*.DBS,DSK:*.AID,DSK:*.JRN
@DELETE DSK:*.REL,DSK:*.EXE
@DELETE DSK:*.TMP
@EXPUNGE DSK:
@ERROR
@COPY DSK:DTSCH.LOC DSK:DTSCH.LOK
@COPY DSK:DTVRB.LOC DSK:DTVRB.LOK
@COPY DSK:DTVRB1.DBC DSK:DTVRB1.DBS
@COPY DSK:DTVRB2.DBC DSK:DTVRB2.DBS
@COPY DSK:DTORD.LOC DSK:DTORD.LOK
@COPY DSK:DTORD1.DBC DSK:DTORD1.DBS
@COPY DSK:DTORD2.DBC DSK:DTORD2.DBS
@COPY DSK:DTORD3.DBC DSK:DTORD3.DBS
@COPY DSK:DTORD4.DBC DSK:DTORD4.DBS

!	Now use /74-COBOL, but first, compile the simple DTSCHB prog
!	If failure, report same, else compare with
!	COBOL compile, if the same, skip to CBL68
@ERROR %
@COMPILE DTSCHB.CBL/74-COBOL
@IF (ERROR) @GOTO C74F1
@RUN SYS:FILCOM
*=DTSCHB.COB,DTSCHB.REL/W/Q
@IF (ERROR) @GOTO C74C2
@ERROR
@RUN UTP:SENDER
*TYPE MAJOR
*BLABEL C74CK:
*TEST DBMS20
*SEND Using CBL74: .REL matched COBOL, test skipped.
*EXIT
@GOTO C68CK

C74C2::
@COMPILE DTORDR.CBL/74-COBOL
@IF (ERROR) @GOTO C74F1
@COMPILE DTVR1S.CBL/74-COBOL
@IF (ERROR) @GOTO C74F1
@COMPILE DTVRB2.CBL/74-COBOL
@IF (NOERROR) @GOTO C74LD

C74F1::
@ERROR
@RESET
@RUN UTP:SENDER
*TYPE MAJOR
*BLABEL C74CK:
*TEST DBMS20
*SEND Using CBL74: DBMS tests failed to compile.
*EXIT
@GOTO C68CK

C74LD::
@ERROR %
@LOAD DTORDR.REL
@IF (ERROR) @GOTO C74F2
@SAVE DTORDR
@IF (ERROR) @GOTO C74F2
@LOAD DTSCHB.REL
@IF (ERROR) @GOTO C74F2
@SAVE DTSCHB
@IF (ERROR) @GOTO C74F2
@LOAD DTVR1S.REL,DTVRB2.REL
@IF (ERROR) @GOTO C74F2
@SAVE DTVRB1
@IF (NOERROR) @GOTO C74EX

C74F2::
@ERROR
@RESET
@RUN UTP:SENDER
*TYPE MAJOR
*BLABEL C74LD:
*TEST DBMS20
*SEND Using CBL74: DBMS tests failed to load.
*EXIT
@GOTO C68CK

C74EX::
@ERROR %
@RUN DTSCHB
@IF (ERROR) @GOTO C74F3
@ERROR
!	May have a warning
@RUN DTVRB1
@IF (ERROR) @GOTO C74F3
@ERROR %
@RUN DTORDR
*BEGIN
*ENTER
*PROD
*KA10
*CENTRAL PROCESSOR
*140000
*DF10
*DATA CHANNEL
*14000
*KI10
*CENTRAL PROCESSOR
*240000
*
*SLSENG
*HOGAN, R.
*MAYNARD
*617
*897-5111
*2968
*CARMICHAEL, R.
*SANTA ANNA
*714
*979-2460
*2
*BRANDT, D.
*CAMBRIDGE
*617
*491-6130
*2522
*CUTHBERTSON, F.
*CAMBRIDGE
*617
*491-6130
*2522
*
*CUSTOM
*DEC
*146 MAIN ST.
*MAYNARD
*MASS.
*01754
*
*YES
*070973
*KA10
*3
*DF10
*4
*
*CUSTOM
*COPLEY
*2525 PACIFIC BEACH BLVD.
*SAN DIEGO
*CALIF.
*07111
*CARMICHAEL, R.
*YES
*071173
*KA10
*1
*
*CUSTOM
*FIRST CHURCH
*25 HUNTINGTON AVE.
*BOSTON
*MASS.
*02139
*BRANDT, D.
*YES
*071173
*KI10
*1
*DF10
*3
*
*CUSTOM
*SPAN
*25 TURNPIKE ROAD
*PROVIDENCE
*RHODE ISLAND
*01800
*CUTHBERTSON, F.
*NO
*
*INQUIRY
*CUSTOM
*DEC
*YES
*YES
*
*ENTER
*PROD
*MC10
*MEMORY PORT AND CABLE
*1000
*MD10-E
*MD10 32K WORD MEMORY EXPANSION MODULE
*42000
*
*PURORD
*DEC
*071273
*MC10
*2
*
*
*QUIT
@IF (ERROR) @GOTO C74F3
@ERROR
@RUN UTP:SENDER
*TYPE MAJOR
*BLABEL C74EX:
*TEST DBMS20
*SEND Using CBL74: DBMS tests completed OK.
*EXIT
!	Note a successful host run
@COPY NUL: DSK:DTHOST.OK.1
@GOTO C68CK

C74F3::
@ERROR
@RESET
@RUN UTP:SENDER
*TYPE MAJOR
*BLABEL C74EX:
*TEST DBMS20
*SEND Using CBL74: DBMS tests failed to execute.
*EXIT


C68CK::
!	Now try CBL68
!	If no SYS:CBL68.EXE, skip all this
@ERROR %
@DIRECT SYS:CBL68.EXE
@IF (ERROR) @GOTO FORTS
!	First, get fresh copy of .LOK and .DBS, and no .JRNs
!	And delete previous .RELs and .EXEs
@NOERROR
@RESET
@DELETE DSK:*.LOK,DSK:*.DBS,DSK:*.JRN
@DELETE DSK:*.REL,DSK:*.EXE
@DELETE DSK:*.TMP
@EXPUNGE DSK:
@ERROR
@COPY DSK:DTSCH.LOC DSK:DTSCH.LOK
@COPY DSK:DTVRB.LOC DSK:DTVRB.LOK
@COPY DSK:DTVRB1.DBC DSK:DTVRB1.DBS
@COPY DSK:DTVRB2.DBC DSK:DTVRB2.DBS
@COPY DSK:DTORD.LOC DSK:DTORD.LOK
@COPY DSK:DTORD1.DBC DSK:DTORD1.DBS
@COPY DSK:DTORD2.DBC DSK:DTORD2.DBS
@COPY DSK:DTORD3.DBC DSK:DTORD3.DBS
@COPY DSK:DTORD4.DBC DSK:DTORD4.DBS

!	Now use /68-COBOL, but first, compile the simple DTSCHB prog
!	If failure, report same, else compare with
!	COBOL compile, if the same, skip to FORTS
@ERROR %
@COMPILE DTSCHB.CBL/68-COBOL
@IF (ERROR) @GOTO C68F1
@RUN SYS:FILCOM
*=DTSCHB.COB,DTSCHB.REL/W/Q
@IF (ERROR) @GOTO C68C2
@ERROR
@RUN UTP:SENDER
*TYPE MAJOR
*BLABEL C68CK:
*TEST DBMS20
*SEND Using CBL68: .REL matched COBOL, test skipped.
*EXIT
@GOTO FORTS

C68C2::
@COMPILE DTORDR.CBL/68-COBOL
@IF (ERROR) @GOTO C68F1
@COMPILE DTVR1S.CBL/68-COBOL
@IF (ERROR) @GOTO C68F1
@COMPILE DTVRB2.CBL/68-COBOL
@IF (NOERROR) @GOTO C68LD

C68F1::
@ERROR
@RESET
@RUN UTP:SENDER
*TYPE MAJOR
*BLABEL C68CK:
*TEST DBMS20
*SEND Using CBL68: DBMS tests failed to compile.
*EXIT
@GOTO FORTS

C68LD::
@ERROR %
@LOAD DTORDR.REL
@IF (ERROR) @GOTO C68F2
@SAVE DTORDR
@IF (ERROR) @GOTO C68F2
@LOAD DTSCHB.REL
@IF (ERROR) @GOTO C68F2
@SAVE DTSCHB
@IF (ERROR) @GOTO C68F2
@LOAD DTVR1S.REL,DTVRB2.REL
@IF (ERROR) @GOTO C68F2
@SAVE DTVRB1
@IF (NoERROR) @GOTO C68EX

C68F2::
@ERROR
@RESET
@RUN UTP:SENDER
*TYPE MAJOR
*BLABEL C68LD:
*TEST DBMS20
*SEND Using CBL68: DBMS tests failed to load.
*EXIT
@GOTO FORTS

C68EX::
@ERROR %
@RUN DTSCHB
@IF (ERROR) @GOTO C68F3
@ERROR
!	May have a warning
@RUN DTVRB1
@IF (ERROR) @GOTO C68F3
@ERROR %
@RUN DTORDR
*BEGIN
*ENTER
*PROD
*KA10
*CENTRAL PROCESSOR
*140000
*DF10
*DATA CHANNEL
*14000
*KI10
*CENTRAL PROCESSOR
*240000
*
*SLSENG
*HOGAN, R.
*MAYNARD
*617
*897-5111
*2968
*CARMICHAEL, R.
*SANTA ANNA
*714
*979-2460
*2
*BRANDT, D.
*CAMBRIDGE
*617
*491-6130
*2522
*CUTHBERTSON, F.
*CAMBRIDGE
*617
*491-6130
*2522
*
*CUSTOM
*DEC
*146 MAIN ST.
*MAYNARD
*MASS.
*01754
*
*YES
*070973
*KA10
*3
*DF10
*4
*
*CUSTOM
*COPLEY
*2525 PACIFIC BEACH BLVD.
*SAN DIEGO
*CALIF.
*07111
*CARMICHAEL, R.
*YES
*071173
*KA10
*1
*
*CUSTOM
*FIRST CHURCH
*25 HUNTINGTON AVE.
*BOSTON
*MASS.
*02139
*BRANDT, D.
*YES
*071173
*KI10
*1
*DF10
*3
*
*CUSTOM
*SPAN
*25 TURNPIKE ROAD
*PROVIDENCE
*RHODE ISLAND
*01800
*CUTHBERTSON, F.
*NO
*
*INQUIRY
*CUSTOM
*DEC
*YES
*YES
*
*ENTER
*PROD
*MC10
*MEMORY PORT AND CABLE
*1000
*MD10-E
*MD10 32K WORD MEMORY EXPANSION MODULE
*42000
*
*PURORD
*DEC
*071273
*MC10
*2
*
*
*QUIT
@IF (ERROR) @GOTO C68F3
@ERROR
@RUN UTP:SENDER
*TYPE MAJOR
*BLABEL C68EX:
*TEST DBMS20
*SEND Using CBL68: DBMS tests completed OK.
*EXIT
!	Note a successful host run
@COPY NUL: DSK:DTHOST.OK.1
@GOTO FORTS

C68F3::
@ERROR
@RESET
@RUN UTP:SENDER
*TYPE MAJOR
*BLABEL C68EX:
*TEST DBMS20
*SEND Using CBL68: DBMS tests failed to execute.
*EXIT



FORTS::
!	See if a FORTRAN to run
@ERROR %
@DIRECT SYS:FORTRA
@IF (NOERROR) @GOTO DBFCK
@ERROR
@RUN UTP:SENDER
*TYPE MAJOR
*BLABEL FORTS:
*TEST DBMS20
*SEND FORTRAN host language unavailable.
*EXIT
@GOTO HSTCK


DBFCK::
!	Will need FORTRAN specific DBCS SYS:DBMSF.EXE
@ERROR %
@DIRECT SYS:DBMSF.EXE
@IF (NOERROR) @GOTO DFLCK
@ERROR
@RUN UTP:SENDER
*TYPE MAJOR
*BLABEL DBFCK:
*TEST DBMS20
*SEND FORTRAN only DBCS file SYS:DBMSF.EXE not found.
*EXIT


DFLCK::
!	Now see if there is a DBMSF.REL. If not, it is possible
!	that the current FORLIB will require one. See if this is so.
@ERROR %
@DIRECT SYS:DBMSF.REL
@IF (NOERROR) @GOTO FORRN

@RUN SYS:LINK
*/REQUIRE:SBIND
*SYS:FORLIB.REL/SEARCH
@IF (NOERROR) @GOTO FORRN
@ERROR
@RUN UTP:SENDER
*TYPE MAJOR
*BLABEL DFLCK:
*TEST DBMS20
*SEND FORTRAN only DBMS load library SYS:DBMSF.REL not found.
*EXIT


FORRN::

!	First, get fresh copy of .LOK and .DBS, and no .JRNs
!	And delete previous .RELs and .EXEs
@NOERROR
@RESET
@DELETE DSK:*.LOK,DSK:*.DBS,DSK:*.JRN
@DELETE DSK:*.REL,DSK:*.EXE
@DELETE DSK:*.TMP
@EXPUNGE DSK:
@ERROR
@COPY DSK:DTSCH.LOC DSK:DTSCH.LOK
@COPY DSK:DTVRB.LOC DSK:DTVRB.LOK
@COPY DSK:DTVRB1.DBC DSK:DTVRB1.DBS
@COPY DSK:DTVRB2.DBC DSK:DTVRB2.DBS
@COPY DSK:DTORD.LOC DSK:DTORD.LOK
@COPY DSK:DTORD1.DBC DSK:DTORD1.DBS
@COPY DSK:DTORD2.DBC DSK:DTORD2.DBS
@COPY DSK:DTORD3.DBC DSK:DTORD3.DBS
@COPY DSK:DTORD4.DBC DSK:DTORD4.DBS

!	Now use DML translated FORTRAN programs
@ERROR %
@COMPILE DTORDR.FOR/LANG:"/NOWARN:CNM"
@IF (ERROR) @GOTO FORF1
@COMPILE DTSCHB.FOR
@IF (ERROR) @GOTO FORF1
@COMPILE DTVRB1.FOR,DTVRB2.FOR
@IF (NOERROR) @GOTO FORLD

FORF1::
@ERROR
@RESET
@RUN UTP:SENDER
*TYPE MAJOR
*BLABEL FORCK:
*TEST DBMS20
*SEND Using FORTRAN: DBMS tests failed to compile.
*EXIT
@GOTO HSTCK

FORLD::
@ERROR %
@LOAD DTORDR.REL
@IF (ERROR) @GOTO FORF2
@SAVE DTORDR
@IF (ERROR) @GOTO FORF2
@LOAD DTSCHB.REL
@IF (ERROR) @GOTO FORF2
@SAVE DTSCHB
@IF (ERROR) @GOTO FORF2
@LOAD DTVRB1.REL,DTVRB2.REL
@IF (ERROR) @GOTO FORF2
@SAVE DTVRB1
@IF (NOERROR) @GOTO FOREX

FORF2::
@ERROR
@RESET
@RUN UTP:SENDER
*TYPE MAJOR
*BLABEL FORLD:
*TEST DBMS20
*SEND Using FORTRAN: DBMS tests failed to load.
*EXIT
@GOTO HSTCK

FOREX::
@ERROR %
@RUN DTSCHB
@IF (ERROR) @GOTO FORF3
@RUN DTVRB1
@IF (ERROR) @GOTO FORF3
@RUN DTORDR
*BEGIN
*ENTER
*PROD
*KA10
*CENTRAL PROCESSOR
*140000
*DF10
*DATA CHANNEL
*14000
*KI10
*CENTRAL PROCESSOR
*240000
*
*SLSENG
*HOGAN, R.
*MAYNARD
*617
*897-5111
*2968
*CARMICHAEL, R.
*SANTA ANNA
*714
*979-2460
*2
*BRANDT, D.
*CAMBRIDGE
*617
*491-6130
*2522
*CUTHBERTSON, F.
*CAMBRIDGE
*617
*491-6130
*2522
*
*CUSTOM
*DEC
*146 MAIN ST.
*MAYNARD
*MASS.
*01754
*
*YES
*070973
*KA10
*3
*DF10
*4
*
*CUSTOM
*COPLEY
*2525 PACIFIC BEACH BLVD.
*SAN DIEGO
*CALIF.
*07111
*CARMICHAEL, R.
*YES
*071173
*KA10
*1
*
*CUSTOM
*FIRST CHURCH
*25 HUNTINGTON AVE.
*BOSTON
*MASS.
*02139
*BRANDT, D.
*YES
*071173
*KI10
*1
*DF10
*3
*
*CUSTOM
*SPAN
*25 TURNPIKE ROAD
*PROVIDENCE
*RHODE ISLAND
*01800
*CUTHBERTSON, F.
*NO
*
*INQUIRY
*CUSTOM
*DEC
*YES
*YES
*
*ENTER
*PROD
*MC10
*MEMORY PORT AND CABLE
*1000
*MD10-E
*MD10 32K WORD MEMORY EXPANSION MODULE
*42000
*
*PURORD
*DEC
*071273
*MC10
*2
*
*
*QUIT
@IF (ERROR) @GOTO FORF3
@ERROR
@RUN UTP:SENDER
*TYPE MAJOR
*BLABEL FOREX:
*TEST DBMS20
*SEND Using FORTRAN: DBMS tests completed OK.
*EXIT
!	Note a successful host run
@COPY NUL: DSK:DTHOST.OK.1
@GOTO HSTCK

FORF3::
@ERROR
@RESET
@RUN UTP:SENDER
*TYPE MAJOR
*BLABEL FOREX:
*TEST DBMS20
*SEND Using FORTRAN: DBMS tests failed to execute.
*EXIT



HSTCK::
!	Now verify that at least one host language test succeeded
@ERROR %
@DIRECT DTHOST.OK
@IF (NOERROR) @GOTO ENDIT
@ERROR
@RUN UTP:SENDER
*TYPE ERROR
*BLABEL HSTCK:
*TEST DBMS20
*SEND No DBMS host language test ran correctly.
*EXIT
@GOTO ENDIT



%TERR::
!	Job timeout
@
@ERROR
@RESET
@RUN UTP:SENDER
*TYPE ERROR
*BLABEL ERR:
*TEST DBMS20
*SEND DBMS20 timed out - rerun test with larger time limit.
*EXIT
@GOTO ENDIT



%ERR::
@GOTO UERR

UERR::
!	An unexpected error occurred somewhere.
@
@ERROR
@RESET
@RUN UTP:SENDER
*TYPE ERROR
*BLABEL ERR:
*TEST DBMS20
*SEND Unexpected DBMS test error - check .LOG file.
*EXIT
@GOTO ENDIT



ENDIT::
!	Cleanup and finish
@NOERROR
@RESET
@DELETE DSK:DTORD.DDL,DSK:DTORD.JRN,DSK:DTORD.LOK,DSK:DTORD.SCH
@DELETE DSK:DTORDR.FOR,DSK:DTORDR.REL,DSK:DTORDR.EXE,DSK:DTSSOF.SUB
@DELETE DSK:DTORD1.DBS,DSK:DTORD2.DBS,DSK:DTORD3.DBS,DSK:DTORD4.DBS
@DELETE DSK:DTORD1.TMP,DSK:DTORD2.TMP,DSK:DTORD3.TMP,DSK:DTORD4.TMP
@DELETE DSK:DTORD1.AID,DSK:DTORD2.AID,DSK:DTORD3.AID,DSK:DTORD4.AID
@DELETE DSK:DTSCH.DDL,DSK:DTSCH.LOK,DSK:DTSCH.SCH
@DELETE DSK:DTSCHB.FOR,DSK:DTSCHB.REL,DSK:DTSCHB.EXE,DSK:DTSSSF.SUB
@DELETE DSK:DTVRB.DDL,DSK:DTVRB.JRN,DSK:DTVRB.LOK,DSK:DTVRB.SCH
@DELETE DSK:DTVRB1.DBS,DSK:DTVRB2.DBS
@DELETE DSK:DTVRB1.FOR,DSK:DTVRB2.FOR,DSK:DTVRB1.REL,DSK:DTVRB2.REL
@DELETE DSK:DTVR1S.REL,DSK:DTVRB1.EXE
@DELETE DSK:DTSSV1.SUB,DSK:DTSSV2.SUB
@DELETE DSK:DTORD.LOC,DSK:DTORD1.DBC,DSK:DTORD2.DBC,DSK:DTORD3.DBC
@DELETE DSK:DTORD4.DBC
@DELETE DSK:DTSCH.LOC,DSK:DTVRB.LOC,DSK:DTVRB1.DBC,DSK:DTVRB2.DBC
@DELETE DSK:DTORD.DBI,DSK:DTORD.ABS,DSK:DTORDB.ABS
@DELETE DSK:DTHOST.OK,DSK:DTUTL.OK,DSK:DTSCHB.COB
@DELETE DSK:DTXDM.CMD,DSK:DTXDM.DCA,DSK:DTXDM.LOG
@DELETE DSK:*.TMP
@EXPUNGE DSK:
@ERROR
@RUN UTP:SENDER
*TYPE END
*BLABEL ENDIT
*TEST DBMS20
*SEND End of DBMS test.
*EXIT

%FIN::

!	End of tests.