TITLE 'TEST CALL TO PC/370 SUBROUTINE FROM MICRO FOCUS COBOL'
* PGM-ID. TEST370.ALC
* AUTHOR. DON HIGGINS.
* DATE.   08/29/87.
* REMARKS.
*
*           THIS SPECIFIC PROGRAM VERIFIES THE FOLLOWING ARGUMENTS
*           PASSED FROM CALL370.CBL WORKING STORAGE AS FOLLOWS:
*
*             01 D-DATE PIC 9(6)               VALUE 082987.
*             01 X-DATE PIC X(6)               VALUE '082987'.
*             01 P-DATE PIC 9(15) USAGE COMP-3 VALUE 082987.
*             01 C-DATE PIC 9(8)  USAGE COMP   VALUE 082987.
*
*           CALL "TEST370" USING D-DATE X-DATE P-DATE C-DATE.
*
*           AT ENTRY TO TEST370 THE 370 REGISTERS ARE SET AS FOLLOWS:
*
*             R1 = ADDRESS OF ADDRESS LIST WITH HIGH BIT SET IN LAST
*                  WORD OF LIST.
*
*             R13 = STANDARD SAVE AREA
*             R14 = RETURN ADDRESS
*             R15 = ENTRY  ADDRESS
*
* MAINTENANCE.
*
* 11/20/87 DSH CLEAR R15 COBOL RETURN CODE AT EXIT
*
TEST370  CSECT
	USING *,R15
	LM    R3,R6,0(R1)
	LA    R2,=C'HELLO FROM TEST370$'
	SVC   WTO
	LTR   R6,R6
	BNM   ERR5               MISSING ENDING HIGH BIT
	CLC   0(6,R3),=C'082987' CHECK EBCDIC D-DATE.
	BNE   ERR1
	CLC   0(6,R4),=C'082987' CHECK EBCDIC X-DATE.
	BNE   ERR2
	CP    0(8,R5),=P'082987' CHECK PACKED DATE
	BNE   ERR3
	CLC   0(4,R6),=F'082987' BINARY DATE
	BNE   ERR4
	LA    R2,=C'ALL DATA FIELD TESTS SUCCESSFUL!$'
	SVC   WTO
	XR    R15,R15
	BR    R14
ERR1     LA    R2,=C'D-DATE ERROR$'
	SVC   WTO
	SVC   TRACE
	DC    C'BUG '
	LA    R15,1
	BR    R14
ERR2     LA    R2,=C'X-DATE ERROR$'
	SVC   WTO
	SVC   TRACE
	DC    C'BUG '
	LA    R15,2
	BR    R14
ERR3     LA    R2,=C'P-DATE ERROR$'
	SVC   WTO
	SVC   TRACE
	DC    C'BUG '
	LA    R15,3
	BR    R14
ERR4     LA    R2,=C'C-DATE ERROR$'
	SVC   WTO
	SVC   TRACE
	DC    C'BUG '
	LA    R15,4
	BR    R14
ERR5     LA    R2,=C'MISSING END OF ADDRESS LIST BIT ERROR$'
	SVC   WTO
	SVC   TRACE
	DC    C'BUG '
	LA    R15,5
	BR    R14
	COPY  CPY\EQUREGS
	COPY  CPY\EQUSVCS
	END