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     ! 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.