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

	PROGRAM COMEQ

C THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
C   OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
C 
C COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1983

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