Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
20 changes: 20 additions & 0 deletions example/get-flag-value.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,20 @@
program get_flag_value
!! Demonstrate how to find the value of a command-line flag
use command_line_m, only : command_line_t
implicit none

type(command_line_t) command_line
character(len=:), allocatable :: input_file_name

input_file_name = command_line%flag_value("--input-file")

! Running this program as follows with the command
!
! fpm run --example get-flag-value -- --input-file foo
!
! result in normal termination.

print *,"input file: ",input_file_name

if (input_file_name/="foo") error stop "example/get-flag-value: expected flag value 'foo' not receieved"
end program
9 changes: 9 additions & 0 deletions src/command_line_m.f90
Original file line number Diff line number Diff line change
Expand Up @@ -8,11 +8,13 @@ module command_line_m
type command_line_t
contains
procedure, nopass :: argument_present
procedure, nopass :: flag_value
end type

interface

module function argument_present(acceptable_argument) result(found)
implicit none
!! result is .true. only if a command-line argument matches an element of this function's argument
character(len=*), intent(in) :: acceptable_argument(:)
!! sample list: [character(len=len(<longest_argument>)):: "--benchmark", "-b", "/benchmark", "/b"]
Expand All @@ -21,6 +23,13 @@ module function argument_present(acceptable_argument) result(found)
logical found
end function

module function flag_value(flag) result(flag_val)
!! result is the value passed adjacent to a command-line flag
implicit none
character(len=*), intent(in) :: flag
character(len=:), allocatable :: flag_val
end function

end interface

end module
19 changes: 19 additions & 0 deletions src/command_line_s.f90
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
submodule(command_line_m) command_line_s
use assert_m, only : assert
implicit none

contains
Expand Down Expand Up @@ -34,4 +35,22 @@

end procedure

module procedure flag_value

integer argnum, arglen
character(len=64) arg

flag_search: &
do argnum = 1,command_argument_count()
call get_command_argument(argnum, arg, arglen)
if (arg==flag) then
call assert(arglen<=len(arg), "flag_value: arglen<=len(arg)")
allocate(character(len=arglen) :: flag_val)
call get_command_argument(argnum+1, flag_val)
exit flag_search
end if
end do flag_search

end procedure

end submodule
45 changes: 45 additions & 0 deletions test/command_line_test.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,45 @@
module command_line_test
!! Verify object pattern asbtract parent
use test_m, only : test_t, test_result_t
use command_line_m, only : command_line_t
implicit none

private
public :: command_line_test_t

type, extends(test_t) :: command_line_test_t
contains
procedure, nopass :: subject
procedure, nopass :: results
end type

contains

pure function subject() result(specimen)
character(len=:), allocatable :: specimen
specimen = "The command_line_t type"
end function

function results() result(test_results)
type(test_result_t), allocatable :: test_results(:)

test_results = [ &
test_result_t("returning the value passed after a command-line flag", check_flag_value()) &
]
end function

function check_flag_value() result(test_passes)
logical test_passes

integer exit_status, command_status
character(len=132) command_message

call execute_command_line( &
command = "fpm run --example get-flag-value -- --input-file foo > /dev/null 2>&1", &
wait = .true., exitstat = exit_status, cmdstat = command_status, cmdmsg = command_message &
)
test_passes = exit_status == 0

end function

end module command_line_test
3 changes: 3 additions & 0 deletions test/main.f90
Original file line number Diff line number Diff line change
Expand Up @@ -4,13 +4,15 @@ program main
use object_m_test, only : object_test_t
use formats_test, only : formats_test_t
use test_result_test, only : test_result_test_t
use command_line_test, only : command_line_test_t
implicit none

type(collectives_test_t) collectives_test
type(data_partition_test_t) data_partition_test
type(formats_test_t) formats_test
type(object_test_t) object_test
type(test_result_test_t) test_result_test
type(command_line_test_t) command_line_test

integer :: passes=0, tests=0

Expand All @@ -19,6 +21,7 @@ program main
call object_test%report(passes, tests)
call formats_test%report(passes, tests)
call test_result_test%report(passes, tests)
call command_line_test%report(passes, tests)

print *
print *,"_________ In total, ",passes," of ",tests, " tests pass. _________"
Expand Down