Return to t18.f CVS log

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

Annotation of cci/usr/src/usr.bin/f77/f77pass1/tst/t18.f, revision 1.1.1.1

1.1       root        1: c      subroutine tst18
                      2:        parameter(ntest=18)
                      3: c      Subroutine and function as arguments
                      4: 
                      5:        integer incr,decr,double,eval,apply,twice
                      6:        twice(k) = 2*k
                      7:        inc(k) = k+1
                      8:        i=10
                      9:        j=20
                     10:        if ( incr(0) .ne. 1 ) call e(1,ntest)
                     11:        if ( decr(i) .ne. 9 ) call e(2,ntest)
                     12:        if ( double(i+j) .ne. 60 ) call e(3,ntest)
                     13:        if ( incr(double(j)) .ne. 41 ) call e(4,ntest)
                     14:        if ( decr(double(incr(double(i)))) .ne. 41 ) call e(5,ntest)
                     15:        if ( incr(incr(incr(incr(incr(5))))) .ne. 10 ) call e(6,ntest)
                     16:        if ( eval(incr,i) .ne. 11 ) call e(7,ntest)
                     17:        if ( eval(decr,3) .ne. 2 ) call e(8,ntest)
                     18:        if ( incr(eval(double,15)) .ne. 31 ) call e(9,ntest)
                     19:        if ( apply(incr,3) .ne. 4 ) call e(10,ntest)
                     20: 
                     21:        call x1(double,i,j)
                     22:        if ( j .ne. 40 ) call e(11,ntest)
                     23:        call x1(incr,i+3,j)
                     24:        if ( j .ne. 27 ) call e(12,ntest)
                     25:        call p1(3,5,324,13)
                     26:        call p1(10,4,400,14)
                     27:        call p1(1,8,1369,15)
                     28:        j=1
                     29:        if ( inc(incr(twice(double(inc(incr(twice(double(j)))))))) .ne. 26 ) call e(13,ntest)
                     30:        end
                     31: 
                     32:        integer function incr(k)
                     33:        incr = k+1
                     34:        end
                     35:        integer function decr(k)
                     36:        decr = k-1
                     37:        end
                     38:        integer function double(k)
                     39:        double = 2*k
                     40:        end
                     41:        integer function eval(f,a)
                     42:        integer f,a
                     43:        external f
                     44:        eval=f(a)
                     45:        end
                     46:        integer function apply(f,a)
                     47:        integer f,a,eval
                     48:        external f
                     49:        apply=eval(f,a)
                     50:        end
                     51: 
                     52:        subroutine x1(f,a,r)
                     53:        integer f,a,r
                     54:        external f
                     55:        call x2(f, a+a, r)
                     56:        end
                     57:        subroutine x2(g,b,s)
                     58:        integer g,b,s,apply
                     59:        external g
                     60:        s=apply(g,b)
                     61:        end
                     62: 
                     63:        subroutine p0(p,i,j)
                     64:        external p
                     65:        if ( j.eq.0 )then
                     66:        call p(i)
                     67:        else
                     68:        call p0(p,i+j,j-1)
                     69:        endif
                     70:        end
                     71: 
                     72:        subroutine p1(a,b,c,d)
                     73:        common /p1c/ k
                     74:        integer a,b,c,d
                     75:        external p2
                     76:        k=0
                     77:        call p0(p2,a,b)
                     78:        if ( k .ne. c ) call e(d,18)
                     79:        end
                     80:        subroutine p2(x)
                     81:        common /p1c/ k
                     82:        integer x
                     83:        k= x*x
                     84:        end

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