** Copyright (c) 1989, NVIDIA CORPORATION.  All rights reserved.
**
** Licensed under the Apache License, Version 2.0 (the "License");
** you may not use this file except in compliance with the License.
** You may obtain a copy of the License at
**
**     http://www.apache.org/licenses/LICENSE-2.0
**
** Unless required by applicable law or agreed to in writing, software
** distributed under the License is distributed on an "AS IS" BASIS,
** WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
** See the License for the specific language governing permissions and
** limitations under the License.

*   Character expressions as subprogram arguments.

	program p
	call mysub('a', 'XYZ', '3456789')
	return
	end

	subroutine mysub(ca, cxyz, c39)
	character*(*) ca, c39, cxyz*3

	parameter(n=37)
	integer irslts(n), expect(n)
	character*4 crslts(n)
	equivalence(irslts, crslts)

	character*3 cf, csf, c2*2, loc1*1, loc6*6, loca(4)*2

	csf(c2) = '.' // c2
	data loc1, loc6, loca / 'm', 'nopqrs', 'bc', 'de', 'fg', 'hi'/
	data i2, i3 / 2, 3 /

c --- test 1:

	data expect(1) / 11 /
c         ca and c39 have passed-length 4:
	irslts(1) = len(ca // c39 // cxyz )

c --- tests 2 - 7:

	data (expect(i), i = 2, 7) / 'a   ', '3456', 'XYZ ', 1, 7, 3 /
	call sub1(crslts(2), ca, c39, cxyz, irslts(5))

c --- tests 8 - 13:

	data (expect(i), i = 8, 13)/ 'aXYZ', '4567', '5678', 4, 4, 4 /
	call sub1(crslts(8), 'a'//cxyz, c39(2:5), c39(i3:2*i3),
     +                                                   irslts(11))

c --- tests 14 - 19:

	data (expect(i), i = 14,19)/ '\05 ', 'Acde', 'YZ  ', 1, 4, 3 /
	call sub1(crslts(14), char(5), 'A' // ('c'//'de'), cf(cxyz),
     +                                                    irslts(17))

c --- tests 20 - 25:

	data (expect(i), i = 20,25)/ 'aYZ ', '-bcd', 'fg  ', 3, 5, 2 /
	call sub1(crslts(20), ca(1:1) // cxyz(i2:i3),
     +              '-' // cf('abcde') // '+', loca(i3), irslts(23))

c --- tests 26 - 31:

	data (expect(i), i = 26,31)/ 'mXYZ', '4eee', 'Z   ', 6, 4, 3 /
	call sub1(crslts(26), loc1 // cxyz // loca(4),
     +              c39(i2:i2) // 'eee', cf(cf(cxyz)), irslts(29))

c --- tests 32 - 37:

	data (expect(i), i = 32,37)/ 'bc  ', '.89 ', '2342', 2, 3, 6 /
	call sub1(crslts(32), loca, csf(c39(6:7)),
     +              cf('12345') // cf('12345'), irslts(35))

c --- check results:

	call check(irslts, expect, n)
	end


	subroutine sub1(crslts, c1, c2, c3, irslts)
	character*(*) c1, c2, c3, crslts(3)
	integer irslts(3)

	crslts(1) = c1
	crslts(2) = c2
	crslts(3) = c3

	irslts(1) = len(c1)
	irslts(2) = len(c2)
	irslts(3) = len(c3)

	end


	function cf(c)
	character*(*) cf, c
	cf = c(2:)
	end