PROGRAM COMEQ

C COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1983, 1986
C ALL RIGHTS RESERVED.
C 
C THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
C ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
C INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
C COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
C OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
C TRANSFERRED.
C 
C THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
C AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
C CORPORATION.
C 
C DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
C SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

C CDM
C October 1981

C Test for character common/equivalence statements.

	COMMON CHAR1,CHAR2/AREA1/CHAR3,CH4
	CHARACTER CHAR1*3,CHAR2*9
	CHARACTER CHAR3*7,CH4(2)*3

C Assign the common areas.

C	blank
C	'Now is the t'

	CHAR1='Now'
	CHAR2=' is the t'

C	AREA1
C	'ime for all g'

	CHAR3='ime for'
	CH4(1)=' al'
	CH4(2)='l g'

	CALL CHECK

	STOP 'End of COMMON/EQUIVALENCE test.'
	END

C-CHECK-
	SUBROUTINE CHECK

C Checks assignments to blank and AREA1 commons via EQUIVALENCE
C statements.

	COMMON /AREA1/CHAR2,CH3,CHAR4 //CH1
	CHARACTER CH1(3)*4,CHAR5*8
	CHARACTER CHAR2*4,CH3(1)*5,CHAR4*4

	EQUIVALENCE (CH1(2),CHAR5)

C	blank
C	'Now is the t'

	IF (CH1(1) .NE. 'Now ')	 TYPE 100, CH1(1)
	IF (CHAR5 .NE. 'is the t') TYPE 200, CHAR5

C	AREA1
C	'ime for all g'

	IF (CHAR2.NE.'ime ') TYPE 300, CHAR2
	IF (CH3(1).NE.'for a') TYPE 400, CH3(1)
	IF (CHAR4.NE.'ll g') TYPE 500,CHAR4

100	FORMAT(' ?Error 100. CH1(1)='''A4''', should = ''Now ''')
200	FORMAT(' ?Error 200. CHAR5='''A8''', should = ''is the t''')
300	FORMAT(' ?Error 300. CHAR2='''A4''', should = ''ime ''')
400	FORMAT(' ?Error 400. CH3(1)='''A5''', should = ''for a''')
500	FORMAT(' ?Error 500. CHAR4='''A4''', should = ''ll g''')

	RETURN
	END