为方便起见，这里有一个用于编译 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 语法集（直接赋值加上基本的读/写语句等）。
这种脚本的一个潜在用途是查找可能被修改的 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: []