Adding dependencies
Obsah
Adding dependencies¶
This tutorial covers the usage of dependencies with fpm and how to reuse existing fpm projects.
Using the standard library¶
We start with a new project with fpm, we want to build a command line application to read a file, find a certain pattern and replace it. Since we do not want to write the replace function ourselves, we will use the Fortran standard library (stdlib) as dependency. In the package manifest we define stdlib in the dependencies table:
name = "demo"
version = "0.1.0"
[dependencies]
stdlib = "*"
Now we create a module with a procedure to perform the substitution. It requires three steps:
reading a whole line from one unit
replace the pattern in the string
write the new string to an output
We will use the replace_all function from the stdlib_strings module for this purpose. The implementation is shown here
module demo
use stdlib_io, only : getline
use stdlib_strings, only : replace_all
implicit none
private
public :: substitute
contains
!> Read all lines from input, replace pattern and print it to output
subroutine substitute(input, output, pattern, replacement)
!> Formatted input unit
integer, intent(in) :: input
!> Formatted output unit
integer, intent(in) :: output
!> Pattern to replace in input
character(len=*), intent(in) :: pattern
!> Replacement for pattern in output
character(len=*), intent(in) :: replacement
character(len=:), allocatable :: line
integer :: stat
do
call getline(input, line, stat)
if (stat /= 0) exit
write(output, '(a)') replace_all(line, pattern, replacement)
end do
end subroutine substitute
end module demo
Finally, we need a command line driver to make use of our new function.
program main
use, intrinsic :: iso_fortran_env, only : output_unit
use demo, only : substitute
implicit none
character(len=256) :: pattern, replacement, input_file
integer :: input
call get_command_argument(1, pattern)
call get_command_argument(2, replacement)
call get_command_argument(3, input_file)
open(newunit=input, file=input_file, status='old')
call substitute(input, output_unit, trim(pattern), trim(replacement))
close(input)
end program main
We can check our command line driver by running it with fpm:
❯ fpm run -- demo substitute fpm.toml
name = "substitute"
version = "0.1.0"
[dependencies]
stdlib = "*"
Adding a testing framework¶
Before we continue implementing new features, we want to add some tests to verify that our implementation keeps working as we modify it. A minimalist testing framework is available with test-drive. Since the testing framework is only required when developing the package itself, but not for other packages which might in the future make use of our modules, we add it as a development dependency. The test-drive package is added in the dev-dependencies table as shown below
name = "demo"
version = "0.1.0"
[dependencies]
stdlib = "*"
[dev-dependencies]
test-drive.git = "https://github.com/fortran-lang/test-drive"
test-drive.tag = "v0.4.0"
Poznámka
For a development dependency like a testing framework we choose a strict version pin by specifying the tag we want to use.
Now we can write a simple unit test, since our function works with units, we will create scratch units to create the input and capture the output. For now we will add a simple one line substitution as single test case
module test_demo
use demo, only : substitute
use stdlib_io, only : getline
use testdrive, only : error_type, unittest_type, new_unittest, check
implicit none
private
public :: collect_demo
contains
!> Collect all exported unit tests
subroutine collect_demo(testsuite)
!> Collection of tests
type(unittest_type), allocatable, intent(out) :: testsuite(:)
testsuite = [new_unittest("substitute", test_substitute)]
end subroutine collect_demo
!> Check substitution of a single line
subroutine test_substitute(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
integer :: input, output, stat
character(len=:), allocatable :: line
open(newunit=input, status="scratch")
write(input, '(a)') "This is a valid test"
rewind(input)
open(newunit=output, status="scratch")
call substitute(input, output, "test", "example")
close(input)
rewind(output)
call getline(output, line, stat)
close(output)
call check(error, line, "This is a valid example")
end subroutine test_substitute
end module test_demo
program tester
use, intrinsic :: iso_fortran_env, only : error_unit
use testdrive, only : run_testsuite
use test_demo, only : collect_demo
implicit none
integer :: stat
stat = 0
call run_testsuite(collect_demo, error_unit, stat)
if (stat > 0) then
write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!"
error stop
end if
end program tester
We run our new test using fpm
❯ fpm test
Starting substitute ... (1/1)
... substitute [PASSED]
Creating the scratch units for multiple unit tests will be repetitive, this kind of tasks can usually be done in a separate procedure and reused in several tests.
Target-specific dependencies¶
Dependencies can also be used for specific targets only. This can be used for adding a command line interface package, which is only used for the executable but not part of the library dependencies.
name = "demo"
version = "0.1.0"
[dependencies]
stdlib = "*"
[dev-dependencies]
test-drive.git = "https://github.com/fortran-lang/test-drive"
test-drive.tag = "v0.4.0"
[[executable]]
name = "demo"
[executable.dependencies]
M_CLI2.git = "https://github.com/urbanjost/M_CLI2"
We restructure our main program a bit for using M_CLI2 to handle the command line input. The unnamed array contains all positional command line arguments, we still use the first two as pattern and replacement, and use all remaining arguments as input. We also add an option to redirect the output. Our final main program looks like
program main
use, intrinsic :: iso_fortran_env, only : output_unit
use demo, only : substitute
use m_cli2, only : set_args, unnamed, sget
implicit none
character(len=:), allocatable :: input_file, output_file, pattern, replacement
integer :: input, output, i
call set_args("--output:o ''")
output_file = trim(sget("output"))
if (len(output_file) > 0) then
open(file=output_file, newunit=output)
else
output = output_unit
end if
pattern = trim(unnamed(1))
replacement = trim(unnamed(2))
do i = 3, size(unnamed)
input_file = trim(unnamed(i))
open(file=input_file, newunit=input, status='old')
call substitute(input, output_unit, trim(pattern), trim(replacement))
close(input)
end do
if (output /= output_unit) close(output)
end program main
Again we run a quick check using fpm
❯ fpm run -- demo substitute fpm.toml
name = "substitute"
version = "0.1.0"
[dependencies]
stdlib = "*"
[dev-dependencies]
test-drive.git = "https://github.com/fortran-lang/test-drive"
test-drive.tag = "v0.4.0"
[[executable]]
name = "substitute"
[executable.dependencies]
M_CLI2.git = "https://github.com/urbanjost/M_CLI2"
The output looks as expected with two substitutions.
Summary
In this tutorial you learned how to
depend on another fpm project in the package manifest
add development dependencies for testing
use dependencies for executables