Google
 

Trailing-Edge - PDP-10 Archives - k20v7d - uetp/lib/substr.for
There are 9 other files named substr.for in the archive. Click here to see a list.
	PROGRAM SUBSTR

C COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1983, 1985
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	Jan-82
C	CDM

C	Tests character data
C	Substring

	CHARACTER*2 CHAR1*7,CHAR2,CHAR3*10,CHAR4(3,3)*7
	CHARACTER CHAR5(5)*5,CHAR6

C-100-	Substring tests
C	In logical comparison

	CHAR1='Boscone'
	CHAR2='co'

	IF (CHAR1(4:5) .NE. CHAR2) TYPE 100, CHAR1(4:5),CHAR2
100	FORMAT(' ?Error 100. CHAR1(4:5)='A10', CHAR2='A2)

C-200-	In assignment

	CHAR3='ABCDEFGHIJ'
	CHAR3(5:8)=CHAR3(3:10)

	IF (CHAR3 .NE. 'ABCDCDEFIJ') TYPE 200,CHAR3
200	FORMAT(' ?Error 200. CHAR3(3:10)='A10', should = ',
	1 '''ABCDCDEFIJ''')

C-300-	Of array

	CHAR4(2,3)='NMOPQRSTUV'
	CHAR5(3)='WXYZABC'
C	'MOP' // 'XYZA'
	CHAR4(2,3)=CHAR4(2,3)(2:4) // CHAR5(3)(2:5)

	IF (CHAR4(2,3)(2:5) .NE. 'OPXY') TYPE 300,CHAR4(2,3)(2:5)
300	FORMAT(' ?Error 300. CHAR4(2,3)(2:5) ='A4', should = ',
	1 '''OPXY''')

C-400-	On left of assignment with array

	CHAR4(2,3)(2:4)='POW'

	IF (CHAR4(2,3) .NE. 'MPOWYZA') TYPE 400,CHAR4(2,3)
400	FORMAT(' ?Error 400. CHAR4(2,3)='A10', should = ''MPOWYZA''')

	STOP
	END