def test_fn_declaration():
e = FortranEvaluator()
e.evaluate("""\
integer function fn0()
fn0 = 5
end function
""")
e.evaluate("""\
integer function fn1(a)
integer, intent(in) :: a
fn1 = 5
end function
""")
e.evaluate("""\
integer function fn2(a, b)
integer, intent(in) :: a, b
fn2 = 5
end function
""")
e.evaluate("""\
integer function fn3(a, b, c)
integer, intent(in) :: a, b, c
fn3 = 5
end function
""")
def test_intrinsics():
e = FortranEvaluator()
e.evaluate("""\
integer, parameter :: dp = kind(0.d0)
real(dp) :: a, b, c(4)
integer :: i, r
r = 0
a = 1.1_dp
b = 1.2_dp
if (b-a > 0.2_dp) r = 1
if (abs(b-a) > 0.2_dp) r = 1
if (abs(a-b) > 0.2_dp) r = 1
a = 4._dp
if (abs(sqrt(a)-2._dp) > 1e-12_dp) r = 1
a = 4._dp
if (abs(log(a)-1.3862943611198906_dp) > 1e-12_dp) r = 1
c(1) = -1._dp
c(2) = -1._dp
c(3) = -1._dp
c(4) = -1._dp
call random_number(c)
do i = 1, 4
if (c(i) < 0._dp) r = 1
if (c(i) > 1._dp) r = 1
end do
""")
assert e.evaluate("r") == 0
def test_arrays3():
e = FortranEvaluator()
e.evaluate("""\
integer function f(a)
integer, intent(in) :: a(3)
integer :: i
f = 0
do i = 1, 3
f = f + a(i)
end do
end function
""")
# TODO: Enable this after [1, 2, 3] is implemented
#assert e.evaluate("f([1, 2, 3])") == 6
e.evaluate("""\
integer :: x(3)
x(1) = 1
x(2) = 2
x(3) = 3
""")
assert e.evaluate("f(x)") == 6
e.evaluate("""\
integer function g()
integer :: x(3)
x(1) = 1
x(2) = 2
x(3) = 3
g = f(x)
end function
""")
assert e.evaluate("g()") == 6
def test_plot():
e = FortranEvaluator()
assert e.evaluate("""\
integer :: a, b
a = 1
b = 5
plot_test(a, b)
""") == 6
def test_subroutine():
e = FortranEvaluator()
e.evaluate("""\
subroutine sub1(a, b)
integer, intent(in) :: a
integer, intent(out) :: b
b = a + 1
end subroutine
""")
def test_fn_dummy():
e = FortranEvaluator()
e.evaluate("""\
function f(a)
integer, intent(in) :: a
f = a + 1
end function
""")
assert e.evaluate("f(2)") == 3
def test_f_call0():
e = FortranEvaluator()
e.evaluate("""\
integer function f()
f = 5
end function
""")
assert e.evaluate("f()+5") == 10
assert e.evaluate("f()+6") == 11
def test_case_sensitivity():
e = FortranEvaluator()
e.evaluate("""\
Integer FUNCTION f(a)
INTEGER, Intent(In) :: a
f = a + 5
End Function
""")
assert e.evaluate("f(2)") == 7
assert e.evaluate("f(5)") == 10
def test_f_call_real_1():
e = FortranEvaluator()
e.evaluate("""\
integer function f(a)
real, intent(in) :: a
f = 0
if (a > 2.7) f = 1
end function
""")
assert e.evaluate("f(2.8)") == 1
assert e.evaluate("f(2.6)") == 0
def test_fn_local():
e = FortranEvaluator()
e.evaluate("""\
function f3(a)
integer, intent(in) :: a
integer :: b
b = 5
f3 = a + b
end function
""")
assert e.evaluate("f3(2)") == 7
def test_f_call_real_2():
e = FortranEvaluator()
e.evaluate("""\
integer function f(a, b)
real, intent(in) :: a, b
real :: c
c = a + b
f = 0
if (c > 2.7) f = 1
end function
""")
assert e.evaluate("f(1.8, 1.0)") == 1
assert e.evaluate("f(1.6, 1.0)") == 0
def test_if_conditions():
e = FortranEvaluator()
e.evaluate("""\
integer :: i
i = 0
if (.false.) i = 1
if (1 == 2) i = 1
if (1 /= 1) i = 1
if (1 > 2) i = 1
if (1 >= 2) i = 1
if (2 < 1) i = 1
if (2 <= 1) i = 1
""")
assert e.evaluate("i") == 0
def test_whitespace4():
e = FortranEvaluator()
e.evaluate("""\
""")
e.evaluate(" ")
e.evaluate("")
def test_do_loops_fn():
e = FortranEvaluator()
e.evaluate("""\
integer function f()
integer :: i, j
j = 0
do i = 1, 10
j = j + i
end do
f = j
end function
""")
assert e.evaluate("f()") == 55
e.evaluate("""\
integer function f2(n)
integer, intent(in) :: n
integer :: i, j
j = 0
do i = 1, n
j = j + i
end do
f2 = j
end function
""")
assert e.evaluate("f2(10)") == 55
assert e.evaluate("f2(20)") == 210
def test_if_then_else_1():
e = FortranEvaluator()
e.evaluate("""\
integer function f(a)
real, intent(in) :: a
f = 3
if (a > 2.7) then
f = 1
else
f = 0
end if
end function
""")
assert e.evaluate("f(2.8)") == 1
assert e.evaluate("f(2.6)") == 0
def test_program():
e = FortranEvaluator()
e.evaluate("""\
program test
implicit none
contains
subroutine sub1(a, b)
integer, intent(in) :: a
integer, intent(out) :: b
b = a + 1
end subroutine
end program
""")
def test_expr():
e = FortranEvaluator()
e.evaluate("""\
integer :: x, i
i = 0
x = (2+3)*5
if (x /= 25) i = 1
x = (2+3)*4
if (x /= 20) i = 1
x = (2+3)*(2+3)
if (x /= 25) i = 1
x = (2+3)*(2+3)*4*2*(1+2)
if (x /= 600) i = 1
x = x / 60
if (x /= 10) i = 1
x = x + 1
if (x /= 11) i = 1
x = x - 1
if (x /= 10) i = 1
x = -2
if (x /= -2) i = 1
x = -2*3
if (x /= -6) i = 1
x = -2*(-3)
if (x /= 6) i = 1
x = 3 - 1
if (x /= 2) i = 1
x = 1 - 3
if (x /= -2) i = 1
if (x /= (-2)) i = 1
x = 1 - (-3)
if (x /= 4) i = 1
if (x /= +4) i = 1
if (x /= (+4)) i = 1
""")
assert e.evaluate("i") == 0
def test_arrays2():
e = FortranEvaluator()
e.evaluate("""\
integer, parameter :: dp = kind(0.d0)
real(dp) :: a(3), b, c
integer :: i
a(1) = 3._dp
a(2) = 2._dp
a(3) = 1._dp
b = sum(a)
if (abs(b-6._dp) < 1e-12_dp) then
i = 1
else
i = 2
end if
""")
assert e.evaluate("i") == 1
def test_variables1():
e = FortranEvaluator()
assert not e._global_scope.resolve("a", False)
e.evaluate("integer :: a")
assert e._global_scope.resolve("a", False)
e.evaluate("a = 5")
assert e._global_scope.resolve("a", False)
assert e.evaluate("a") == 5
assert e._global_scope.resolve("a", False)
assert e.evaluate("a+3") == 8
def test_multiline1():
e = FortranEvaluator()
e.evaluate("""\
integer :: a
a = 5""")
assert e.evaluate("a") == 5
e.evaluate("""\
a = 6
a = a + 1""")
assert e.evaluate("a") == 7
assert e.evaluate("""\
a = 6
a = a + 2
a""") == 8
def test_f_call_outarg():
e = FortranEvaluator()
e.evaluate("""\
integer function f(a, b)
integer, intent(in) :: a
integer, intent(out) :: b
b = a + 5
f = 0
end function
""")
e.evaluate("integer :: i")
assert e.evaluate("f(2, i)") == 0
assert e.evaluate("i") == 7
def test_multiline2():
e = FortranEvaluator()
e.evaluate("""\
integer :: b
b = 5
function f2(a)
integer, intent(in) :: a
f2 = a + b
end function
""")
assert e.evaluate("f2(2)") == 7
e.evaluate("b = 6")
assert e.evaluate("f2(2)") == 8
def test_whitespace2():
e = FortranEvaluator()
e.evaluate("""\
integer :: a
""")
e.evaluate("""\
a = 5
""")
assert e.evaluate("""\
a
""") == 5
def test_f_call_real_int_2():
e = FortranEvaluator()
e.evaluate("""\
integer function f(a, b)
real, intent(in) :: a
integer, intent(in) :: b
f = 0
if (a > 1.7) f = 1
f = f + b
end function
""")
assert e.evaluate("f(1.8, 0)") == 1
assert e.evaluate("f(1.6, 0)") == 0
assert e.evaluate("f(1.8, 1)") == 2
assert e.evaluate("f(1.6, 1)") == 1
def test_print(capfd):
e = FortranEvaluator()
e.evaluate("""\
integer :: x
x = (2+3)*5
print *, x, 1, 3, x, (2+3)*5+x
""")
out = capfd.readouterr().out
assert out.replace("\r", "") == "25 1 3 25 50 \n"
e.evaluate("""\
print *, "Hello world!"
""")
out = capfd.readouterr().out
assert out.replace("\r", "") == "Hello world! \n"
def main(verbose=True):
llvm.initialize()
llvm.initialize_native_asmprinter()
llvm.initialize_native_target()
target = llvm.Target.from_triple(llvm.get_default_triple())
target_machine = target.create_target_machine()
target_machine.set_asm_verbosity(True)
# Empty backing module
backing_mod = llvm.parse_assembly("")
backing_mod.verify()
engine = llvm.create_mcjit_compiler(backing_mod, target_machine)
print("Interactive Fortran.")
print(" * Use Ctrl-D to exit.")
print(" * Use Enter to submit.")
print(" * Features:")
print(" - Multi-line editing (use Alt-Enter)")
print(" - History")
print(" - Syntax highlighting")
print()
fortran_evaluator = FortranEvaluator()
session = PromptSession('> ',
lexer=PygmentsLexer(FortranLexer),
multiline=True,
key_bindings=kb)
try:
while True:
text = session.prompt()
if verbose:
print()
handle_input(engine, fortran_evaluator, text, verbose)
if verbose:
print()
except EOFError:
print("Exiting.")
def test_print(capfd):
import ctypes
libc = ctypes.CDLL(None)
c_stdout = ctypes.c_void_p.in_dll(libc, 'stdout')
e = FortranEvaluator()
e.evaluate("""\
integer :: x
x = (2+3)*5
print *, x, 1, 3, x, (2+3)*5+x
""")
libc.fflush(c_stdout) # The C stdout buffer must be flushed out
out = capfd.readouterr().out
assert out == "25 1 3 25 50 \n"
e.evaluate("""\
print *, "Hello world!"
""")
libc.fflush(c_stdout)
out = capfd.readouterr().out
assert out == "Hello world! \n"
def test_do_loops_interactive():
e = FortranEvaluator()
e.evaluate("""\
integer :: i, j
j = 0
do i = 1, 10
j = j + i
end do
""")
assert e.evaluate("j") == 55
e.evaluate("""\
j = 0
do i = 10, 1, -1
j = j + i
end do
""")
assert e.evaluate("j") == 55
e.evaluate("""\
j = 0
do i = 1, 9, 2
j = j + i
end do
""")
assert e.evaluate("j") == 25
e.evaluate("""\
j = 0
do i = 9, 1, -2
j = j + i
end do
""")
assert e.evaluate("j") == 25
e.evaluate("""\
j = 0
do i = 1, 10, 2
j = j + i
end do
""")
assert e.evaluate("j") == 25
e.evaluate("""\
j = 0
do i = 1, 10, 3
j = j + i
end do
""")
assert e.evaluate("j") == 22
e.evaluate("""\
j = 0
do i = 10, 1, -3
j = j + i
end do
""")
assert e.evaluate("j") == 22
e.evaluate("""\
j = 0
do i = 1, 1
j = j + i
end do
""")
assert e.evaluate("j") == 1
e.evaluate("""\
j = 0
do i = 1, 1, -1
j = j + i
end do
""")
assert e.evaluate("j") == 1
e.evaluate("""\
j = 0
do i = 1, 0
j = j + i
end do
""")
assert e.evaluate("j") == 0
e.evaluate("""\
j = 0
do i = 0, 1, -1
j = j + i
end do
""")
assert e.evaluate("j") == 0
e.evaluate("""\
j = 0
do i = 1, 10
j = j + i
if (i == 2) exit
end do
""")
assert e.evaluate("j") == 3
e.evaluate("""\
j = 0
do i = 1, 10
if (i == 2) exit
j = j + i
end do
""")
assert e.evaluate("j") == 1
e.evaluate("""\
j = 0
do i = 1, 10
if (i == 2) cycle
j = j + i
end do
""")
assert e.evaluate("j") == 53
e.evaluate("""
integer :: a, b
j = 0
a = 1
b = 10
do i = a, b
j = j + i
end do
""")
assert e.evaluate("j") == 55
e.evaluate("""\
a = 0
do i = 1, 10
do j = 1, 10
a = a + (i-1)*10+j
end do
end do
""")
assert e.evaluate("a") == 50 * 101
e.evaluate("""\
a = 0
do i = 1, 10
do j = 1, i
a = a + j
end do
end do
""")
assert e.evaluate("a") == 220
def main():
parser = argparse.ArgumentParser(description="Fortran compiler.")
# Standard options compatible with gfortran or clang
# We follow the established conventions
std = parser.add_argument_group('standard arguments',
'compatible with other compilers')
std.add_argument('file', help="source file", nargs="?")
std.add_argument('-emit-llvm',
action="store_true",
help="emit LLVM IR source code, do not assemble or link")
std.add_argument('-S',
action="store_true",
help="emit assembly, do not assemble or link")
std.add_argument('-c',
action="store_true",
help="compile and assemble, do not link")
std.add_argument('-o', metavar="FILE", help="place the output into FILE")
std.add_argument('-v', action="store_true", help="be more verbose")
std.add_argument('-O3',
action="store_true",
help="turn LLVM optimizations on")
std.add_argument('-E',
action="store_true",
help="not used (present for compatibility with cmake)")
# LFortran specific options, we follow the Python conventions:
# short option (-k), long option (--long-option)
lf = parser.add_argument_group('LFortran arguments',
'specific to LFortran')
lf.add_argument('--ld-musl',
action="store_true",
help="invoke ld directly and link with musl")
lf.add_argument('--show-ast',
action="store_true",
help="show AST for the given file and exit")
lf.add_argument('--show-asr',
action="store_true",
help="show ASR for the given file and exit")
lf.add_argument(
'--show-ast-typed',
action="store_true",
help=
"show type annotated AST (parsing and semantics) for the given file and exit (deprecated)"
)
args = parser.parse_args()
if args.E:
# CMake calls `lfort` with -E, and if we silently return a non-zero
# exit code, CMake does not produce an error to the user.
sys.exit(1)
filename = args.file
verbose = args.v
optimize = args.O3
if not filename:
from lfortran.prompt import main
main(verbose=verbose)
return
basename, ext = os.path.splitext(os.path.basename(filename))
link_only = (open(filename, mode="rb").read(4)[1:] == b"ELF")
if args.o:
outfile = args.o
elif args.S:
outfile = "%s.s" % basename
elif args.emit_llvm:
outfile = "%s.ll" % basename
elif args.c:
outfile = "%s.o" % basename
else:
outfile = "a.out"
if args.c:
objfile = outfile
elif link_only:
objfile = filename
else:
objfile = "tmp_object_file.o"
if not link_only:
# Fortran -> LLVM IR source
if verbose: print("Reading...")
source = open(filename).read()
if verbose: print(" Done.")
if len(sys.argv) == 2 and filename:
# Run as a script:
if verbose: print("Importing evaluator...")
from lfortran.codegen.evaluator import FortranEvaluator
if verbose: print(" Done.")
e = FortranEvaluator()
e.evaluate(source)
return
if verbose: print("Importing parser...")
from .ast import (src_to_ast, SyntaxErrorException, print_tree,
print_tree_typed)
if verbose: print(" Done.")
try:
if verbose: print("Parsing...")
if args.show_ast or args.show_ast_typed or args.show_asr:
ast_tree = src_to_ast(source, translation_unit=False)
else:
ast_tree = src_to_ast(source)
if verbose: print(" Done.")
except SyntaxErrorException as err:
print(str(err))
sys.exit(1)
if args.show_ast:
print_tree(ast_tree)
return
if args.show_asr:
from lfortran import ast_to_asr
from lfortran.asr.pprint import pprint_asr
asr_repr = ast_to_asr(ast_tree)
pprint_asr(asr_repr)
return
if verbose: print("Importing semantic analyzer...")
from .semantic.analyze import create_symbol_table, annotate_tree
if verbose: print(" Done.")
if verbose: print("Symbol table...")
symbol_table = create_symbol_table(ast_tree)
if verbose: print(" Done.")
if verbose: print("Type annotation...")
annotate_tree(ast_tree, symbol_table)
if verbose: print(" Done.")
if args.show_ast_typed:
print_tree_typed(ast_tree)
return
if verbose: print("Importing codegen...")
from .codegen.gen import codegen
if verbose: print(" Done.")
if verbose: print("LLMV IR generation...")
module = codegen(ast_tree, symbol_table)
if verbose: print(" Done.")
if verbose: print("LLMV IR -> string...")
source_ll = str(module)
if verbose: print(" Done.")
# LLVM IR source -> assembly / machine object code
if verbose: print("Initializing LLVM...")
llvm.initialize()
llvm.initialize_native_asmprinter()
llvm.initialize_native_target()
target = llvm.Target.from_triple(module.triple)
target_machine = target.create_target_machine()
target_machine.set_asm_verbosity(True)
if verbose: print(" Done.")
if verbose: print("Loading LLMV IR string...")
mod = llvm.parse_assembly(source_ll)
if verbose: print(" Done.")
if verbose: print("Verifying LLMV IR...")
mod.verify()
if verbose: print(" Done.")
if optimize:
if verbose: print("Optimizing...")
pmb = llvm.create_pass_manager_builder()
pmb.opt_level = 3
pmb.loop_vectorize = True
pmb.slp_vectorize = True
pm = llvm.create_module_pass_manager()
pmb.populate(pm)
pm.run(mod)
if verbose: print(" Done.")
if args.emit_llvm:
with open(outfile, "w") as ll:
ll.write(str(mod))
return
if args.S:
with open(outfile, "w") as o:
o.write(target_machine.emit_assembly(mod))
return
if verbose: print("Machine code...")
with open(objfile, "wb") as o:
o.write(target_machine.emit_object(mod))
if verbose: print(" Done.")
if args.c:
return
# Link object code
base_dir = get_lib_path()
if args.ld_musl:
# Invoke `ld` directly and link with musl. This is system dependent.
musl_dir = "/usr/lib/x86_64-linux-musl"
LDFLAGS = "{1}/liblfortran_runtime_static.a {0}/crt1.o {0}/libc.a".format(
musl_dir, base_dir)
os.system("ld -o %s %s %s" % (outfile, objfile, LDFLAGS))
else:
# Invoke a C compiler to do the linking
os.system("cc -o %s %s -L%s -Wl,-rpath=%s -llfortran_runtime -lm" %
(outfile, objfile, base_dir, base_dir))
if objfile == "tmp_object_file.o":
os.system("rm %s" % objfile)
def test_arrays1():
e = FortranEvaluator()
e.evaluate("""\
integer :: i, a(3)
do i = 1, 3
a(i) = i+10
end do
""")
assert e.evaluate("a(1)") == 11
assert e.evaluate("a(2)") == 12
assert e.evaluate("a(3)") == 13
e.evaluate("""\
integer :: b(4)
do i = 11, 14
b(i-10) = i
end do
""")
assert e.evaluate("b(1)") == 11
assert e.evaluate("b(2)") == 12
assert e.evaluate("b(3)") == 13
assert e.evaluate("b(4)") == 14
e.evaluate("""\
do i = 1, 3
b(i) = a(i)-10
end do
""")
assert e.evaluate("b(1)") == 1
assert e.evaluate("b(2)") == 2
assert e.evaluate("b(3)") == 3
e.evaluate("b(4) = b(1)+b(2)+b(3)+a(1)")
assert e.evaluate("b(4)") == 17
e.evaluate("b(4) = a(1)")
assert e.evaluate("b(4)") == 11