是否有一些工具可以检查 Fortran 程序是否修改了它的参数?

Are there some tools to check if a fortran procedure modifies its argument?

是否有工具可用于检查过程中是否定义了 fortran 过程的哪些参数?我的意思是类似于词法分析器的东西,它只检查赋值(或等效)语句的左侧是否使用了变量。 类似于为参数指定 intent(in) 时编译器所做的检查。

我遇到了一个主要用 Fortran 77 标准(未指定意图)编写的代码,其中的子例程有数百个参数,其中一些子例程每个扩展超过 5000 行代码。我想修改部分代码并重写长子程序。我认为如果我能够追踪到正在更改或未更改的参数,那将很容易。

欢迎提出任何建议。

只是为了定义我的问题的范围并避免无用的讨论: 我知道可以通过调用其他子程序来修改变量。如果有一种工具可以检查给定过程中的直接修改,我可以手动处理。

为方便起见,这里有一个编译Ian的VariableDefinitionContext包的脚本。它使用 -standard-semantics 的 ifort-16.0 成功编译(gfortran-6.1 和 ifort-14 无法在语法支持不足的情况下编译它...)

#!/usr/bin/env python
from __future__ import print_function
import os

with open( "compile-order.txt", "r" ) as f:
    tmp = f.read()
allsrc = tmp.split()

#cmd = "ifort -standard-semantics -warn -check all"
cmd = "ifort -standard-semantics"

obj = ""
for src in allsrc:
    print( "compiling", src )
    os.system( ( cmd + " -c %s" ) % ( src ) )
    obj += src[ :-4 ]+ ".o "
os.system( ( cmd + " %s" ) % ( obj ) )
# Usage: ./a.out test.f90

...但事实证明,下面的命令可以完成同样的工作!! (感谢@IanH)

$ ifort -standard-semantics @compile-order.txt

FWIW,这是另一个 Python 用于打印(可能)修改变量的脚本。此脚本在 gfortran 转储文件中搜索各种符号。与 Ian 的包相比,只考虑了一组最小的 Fortran 语法(直接赋值加上基本的 read/write 语句等)。

这种脚本的一个潜在用途是查找可能修改的 COMMON 变量。以前,我有过使用大量 COMMON 块修改遗留 Fortran 程序的艰难经历,因此它可能对这种情况有用...

#!/usr/bin/env python

from __future__ import print_function
import os, sys

def pushuniq( coll, item ):
    if not ( item in coll ): coll.append( item )

def getvarname( s, proc ):
    try:
        return s.split( proc + ":" )[ 1 ].split("(")[ 0 ].split("%")[ 0 ]
    except:  # ad-hoc!
        return s.split("(")[ 0 ].split("%")[ 0 ]

#------------------------------------------------------------------------
def varcheck( filename, Qwritedump=False ):
    """
    checks and prints potentially modified variables.
    Usage: varcheck.py <filenames>
    Set Qwritedump=True to write dump files.
    """
    #.........................................................
    # Generate gfortran dump file

    cmd = "gfortran -fdump-parse-tree -c %s"          # gfort >=4.7
    # cmd = "gfortran -fdump-fortran-original -c %s"  # gfort >=5

    with os.popen( cmd % ( filename ) ) as p:
        lines = p.readlines()

    base = '.'.join( filename.split('.')[:-1] )
    os.system( "rm -f %s.{o,mod}" % ( base ) )   # remove .o and .mod

    if Qwritedump:
        with open( "%s.dump" % ( filename ), "w" ) as f:
            f.write( ''.join( lines ) )
    #/

    #.........................................................
    # List of variables

    varlist = {}    # (potentially) modified variables
    arglist = {}    # dummy arguments
    comlist = {}    # common variables
    modlist = {}    # module variables
    reslist = {}    # result variables
    sublist = {}    # child subroutines
    namlist = {}    # namelists

    #.........................................................
    # Scan the dump file

    Qread = False
    Qgetarg = False

    for line in lines:

        word = line.split()
        if len( word ) == 0 : continue                # skip blank lines
        if word[ 0 ].isdigit() : word = word[ 1: ]    # remove line numbers

        key = word[ 0 ]

        if key == "Namespace:" : continue

        if key == "procedure":
            proc = word[ -1 ]

            varlist[ proc ] = []
            arglist[ proc ] = []
            comlist[ proc ] = []
            modlist[ proc ] = []
            reslist[ proc ] = []
            namlist[ proc ] = []
            sublist[ proc ] = []
            continue

        if key == "common:": continue
        if key == "symtree:": sym = word[ 1 ].strip("'").lower()

        # result variable
        if ( sym == proc ) and ( key == "result:" ):
            reslist[ proc ].append( word[ 1 ] )

        # dummy arguments
        if "DUMMY" in line:
            arglist[ proc ].append( sym )

        # common variables
        if "IN-COMMON" in line:
            comlist[ proc ].append( sym )

        # module variables
        if ( "VARIABLE" in line ) and ( "USE-ASSOC" in line ):
            modlist[ proc ].append( sym )

        # child subroutines
        if key == "CALL":
            pushuniq( sublist[ proc ], word[ 1 ] )

        # namelists
        if ( key == "READ" ) and ( "NML=" in line ):
            namlist[ proc ].append( word[ -1 ].split("NML=")[ -1 ] )

        # iostat
        if "IOSTAT=" in line:
            tmp = line.split("IOSTAT=")[ 1 ].split()[ 0 ]
            sym = getvarname( tmp, proc )
            pushuniq( varlist[ proc ], (sym, "iostat") )
        #/

        def addmemvar( op ):
            for v in word[ 1: ]:
                if proc in v:
                    sym = getvarname( v, proc )
                    pushuniq( varlist[ proc ], (sym, op) )

        # allocation
        if key == "ALLOCATE"    : addmemvar( "alloc" )
        if key == "DEALLOCATE"  : addmemvar( "dealloc" )
        if "move_alloc" in line : addmemvar( "move_alloc" )

        # search for modified variables
        if key == "READ"   : Qread = True
        if key == "DT_END" : Qread = False

        if ( key == "ASSIGN" ) or \
           ( Qread and ( key == "TRANSFER" ) ) or \
           ( key == "WRITE" and ( proc in word[ 1 ] ) ):

            if key == "ASSIGN"   : code = "assign"
            if key == "WRITE"    : code = "write"
            if key == "TRANSFER" : code = "read"

            sym = getvarname( word[ 1 ], proc )
            pushuniq( varlist[ proc ], (sym, code) )
        #/
    #/

    all_lists = { "var": varlist, "arg": arglist, "com": comlist,
                  "mod": modlist, "res": reslist, "sub": sublist,
                  "nam": namlist }

    #.........................................................
    # Print results

    for proc in varlist.keys():
        print( "-" * 60 )
        print( proc + ":" )

        for tag in [ "arg", "com", "mod", "res" ]:

            if tag == "arg":
                print( "    " + tag + ":", arglist[ proc ] )
            else:
                print( "    " + tag + ":" )

            for (sym, code) in varlist[ proc ]:
                if sym in all_lists[ tag ][ proc ]:
                    print( "        %-10s  (%s)" % (sym, code) )
            #/
        #/

        print( "    misc:" )
        for (sym, code) in varlist[ proc ]:
            if ":" in sym:
                print( "        %-10s  (%s)" % (sym, code) )
        #/

        print( "    call:", sublist[ proc ] )

        if len( namlist[ proc ] ) > 0:
            print( "    namelist:", namlist[ proc ] )
    #/

    return all_lists
#/

#------------------------------------------------------------------------
if __name__ == "__main__":

    if len( sys.argv ) == 1:
        sys.exit( "Usage: varcheck.py <filenames>" )
    else:
        filenames = sys.argv[ 1: ]

    for filename in filenames:
        varcheck( filename )
#/

示例 1:LAPACK zheev

$ ./varcheck.py zheev.f
------------------------------------------------------------
zheev:
    arg: ['jobz', 'uplo', 'n', 'a', 'lda', 'w', 'work', 'lwork', 'rwork', 'info']
        info        (assign)
        work        (assign)
        w           (assign)
        a           (assign)
    com:
    mod:
    res:
    call: ['xerbla', 'zlascl', 'zhetrd', 'dsterf', 'zungtr', 'zsteqr', 'dscal']

示例2:简单测试程序

!--------------------------------------------------------
module myvar
    character(50) :: str
    type mytype
        integer :: n
    endtype
    type(mytype) :: obj
    integer :: foo
end

!--------------------------------------------------------
subroutine mysub( a, b, c, ios, n, p, q, r )
    use myvar
    dimension b(10)
    common /com1/ dat( 50 ), x, y, z, wtf(1000)
    common /com2/ dat2( 50 )
    integer inp, out
    namelist /list/ str
    namelist /list2/ p, q
    inp = 10 ; out = 20

    open( inp, file="test.dat", status="old", iostat=ios10 )
    read( inp, *, iostat=ios ) a, ( b(i), i=3,5 )
    write( out, * ) "hello"
    read( inp, * ) c
    read( inp, list )
    close( inp, iostat=ios30 )

    write( str, "(f8.3)" ) a + c

    do i = 1, n
        dat( i ) = b( i )
    enddo
    x = p + q
    y = x * 2
100 c = dat( 1 ) + x + y
end

!--------------------------------------------------------
subroutine mysub2( &
        a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, &
        b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, &
        c1, c2, c3, c4, c5, c6, c7, c8, c9, c10 )
    a3 = 3.0
    b5 = 5.0
end

!--------------------------------------------------------
function myfunc( x, m )
    common /com2/ dat2(50)
    common /com3/ dat3(50)
100 myfunc = x + dat2( m )
200 m = 5
    where( dat2 < 1.0 ) dat2 = 500.0
end

!--------------------------------------------------------
function myfunc2() result( res )
    use myvar
    implicit none
    integer :: res
    obj % n = 500
    res = obj % n
    call sub2( res )
end

!--------------------------------------------------------
subroutine myalloc( a, ier )
    implicit none
    integer, allocatable :: a(:), b(:)
    integer ier
    allocate( a( 10 ), b( 20 ), source=0, stat=ier )
end

!--------------------------------------------------------
subroutine mydealloc( a, b, ier )
    implicit none
    integer, allocatable :: a(:), b(:)
    integer ier
    deallocate( a, b, stat=ier )
end

!--------------------------------------------------------
subroutine mymovealloc( a, b )
    implicit none
    integer, allocatable :: a(:), b(:)
    call move_alloc( a, b )
end

!--------------------------------------------------------
program main
    use myvar
    implicit none
    integer a, dat
    common /com/ dat

    call mymain_int
    print *, a, dat, foo
contains
    subroutine mymain_int
        integer b
        a = 1
        b = 2
        dat = 100
        foo = 200
    end subroutine
end program

!--------------------------------------------------------
module mymod
    use myvar
    implicit none
    integer bar
contains
    subroutine mymod_sub
        use myvar
        integer a, dat
        common /com/ dat

        call mymod_sub_int
        bar = 300
        print *, a, dat, foo, bar
    contains
        subroutine mymod_sub_int
            integer b
            a = 1
            b = 2
            dat = 100
            foo = 200
        end subroutine
    end subroutine
end module

结果:

------------------------------------------------------------
mysub:
    arg: ['a', 'b', 'c', 'ios', 'n', 'p', 'q', 'r']
        ios         (iostat)
        a           (read)
        b           (read)
        c           (read)
        c           (assign)
    com:
        dat         (assign)
        x           (assign)
        y           (assign)
    mod:
        str         (write)
    res:
    call: []
    namelist: ['list']
------------------------------------------------------------
mysub2:
    arg: ['a1', 'a10', 'a2', 'a3', 'a4', 'a5', 'a6', 'a7', 'a8', 'a9', 'b1', 'b10', 'b2', 'b3', 'b4', 'b5', 'b6', 'b7', 'b8', 'b9', 'c1', 'c10', 'c2', 'c3', 'c4', 'c5', 'c6', 'c7', 'c8', 'c9']
        a3          (assign)
        b5          (assign)
    com:
    mod:
    res:
    call: []
------------------------------------------------------------
myfunc:
    arg: ['m', 'x']
        m           (assign)
    com:
        dat2        (assign)
    mod:
    res:
        myfunc      (assign)
    call: []
------------------------------------------------------------
myfunc2:
    arg: []
    com:
    mod:
        obj         (assign)
    res:
        res         (assign)
    call: ['sub2']
------------------------------------------------------------
myalloc:
    arg: ['a', 'ier']
        ier         (alloc)
        a           (alloc)
    com:
    mod:
    res:
    call: []
------------------------------------------------------------
mydealloc:
    arg: ['a', 'b', 'ier']
        ier         (dealloc)
        a           (dealloc)
        b           (dealloc)
    com:
    mod:
    res:
    call: []
------------------------------------------------------------
mymovealloc:
    arg: ['a', 'b']
        a           (move_alloc)
        b           (move_alloc)
    com:
    mod:
    res:
    call: ['_gfortran_move_alloc']
------------------------------------------------------------
main:
    arg: []
    com:
    mod:
    res:
    misc:
    call: ['mymain_int']
------------------------------------------------------------
mymain_int:
    arg: []
    com:
    mod:
    res:
    misc:
        main:a      (assign)
        main:dat    (assign)
        main:foo    (assign)
    call: []
------------------------------------------------------------
mymod_sub:
    arg: []
    com:
    mod:
    res:
    misc:
        mymod:bar   (assign)
    call: ['mymod_sub_int']
------------------------------------------------------------
mymod_sub_int:
    arg: []
    com:
    mod:
    res:
    misc:
        mymod_sub:a    (assign)
        mymod_sub:dat  (assign)
        mymod_sub:foo  (assign)
    call: []