Return to t18.f CVS log

Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / f77pass1 / tst

Power 6/32 Unix version 1.21

c	subroutine tst18
	parameter(ntest=18)
c	Subroutine and function as arguments

	integer incr,decr,double,eval,apply,twice
	twice(k) = 2*k
	inc(k) = k+1
	i=10
	j=20
	if ( incr(0) .ne. 1 ) call e(1,ntest)
	if ( decr(i) .ne. 9 ) call e(2,ntest)
	if ( double(i+j) .ne. 60 ) call e(3,ntest)
	if ( incr(double(j)) .ne. 41 ) call e(4,ntest)
	if ( decr(double(incr(double(i)))) .ne. 41 ) call e(5,ntest)
	if ( incr(incr(incr(incr(incr(5))))) .ne. 10 ) call e(6,ntest)
	if ( eval(incr,i) .ne. 11 ) call e(7,ntest)
	if ( eval(decr,3) .ne. 2 ) call e(8,ntest)
	if ( incr(eval(double,15)) .ne. 31 ) call e(9,ntest)
	if ( apply(incr,3) .ne. 4 ) call e(10,ntest)

	call x1(double,i,j)
	if ( j .ne. 40 ) call e(11,ntest)
	call x1(incr,i+3,j)
	if ( j .ne. 27 ) call e(12,ntest)
	call p1(3,5,324,13)
	call p1(10,4,400,14)
	call p1(1,8,1369,15)
	j=1
	if ( inc(incr(twice(double(inc(incr(twice(double(j)))))))) .ne. 26 ) call e(13,ntest)
	end

	integer function incr(k)
	incr = k+1
	end
	integer function decr(k)
	decr = k-1
	end
	integer function double(k)
	double = 2*k
	end
	integer function eval(f,a)
	integer f,a
	external f
	eval=f(a)
	end
	integer function apply(f,a)
	integer f,a,eval
	external f
	apply=eval(f,a)
	end

	subroutine x1(f,a,r)
	integer f,a,r
	external f
	call x2(f, a+a, r)
	end
	subroutine x2(g,b,s)
	integer g,b,s,apply
	external g
	s=apply(g,b)
	end

	subroutine p0(p,i,j)
	external p
	if ( j.eq.0 )then
	call p(i)
	else
	call p0(p,i+j,j-1)
	endif
	end

	subroutine p1(a,b,c,d)
	common /p1c/ k
	integer a,b,c,d
	external p2
	k=0
	call p0(p2,a,b)
	if ( k .ne. c ) call e(d,18)
	end
	subroutine p2(x)
	common /p1c/ k
	integer x
	k= x*x
	end

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.