Skip to content

Commit 5ba6896

Browse files
committed
feat(commmand_line): extract flag value & test
1 parent 61b14bc commit 5ba6896

File tree

5 files changed

+96
-0
lines changed

5 files changed

+96
-0
lines changed

example/get-flag-value.f90

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,20 @@
1+
program get_flag_value
2+
!! Demonstrate how to find the value of a command-line flag
3+
use command_line_m, only : command_line_t
4+
implicit none
5+
6+
type(command_line_t) command_line
7+
character(len=:), allocatable :: input_file_name
8+
9+
input_file_name = command_line%flag_value("--input-file")
10+
11+
! Running this program as follows with the command
12+
!
13+
! fpm run --example get-flag-value -- --input-file foo
14+
!
15+
! result in normal termination.
16+
17+
print *,"input file: ",input_file_name
18+
19+
if (input_file_name/="foo") error stop "example/get-flag-value: expected flag value 'foo' not receieved"
20+
end program

src/command_line_m.f90

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,11 +8,13 @@ module command_line_m
88
type command_line_t
99
contains
1010
procedure, nopass :: argument_present
11+
procedure, nopass :: flag_value
1112
end type
1213

1314
interface
1415

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

26+
module function flag_value(flag) result(flag_val)
27+
!! result is the value passed adjacent to a command-line flag
28+
implicit none
29+
character(len=*), intent(in) :: flag
30+
character(len=:), allocatable :: flag_val
31+
end function
32+
2433
end interface
2534

2635
end module

src/command_line_s.f90

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
submodule(command_line_m) command_line_s
2+
use assert_m, only : assert
23
implicit none
34

45
contains
@@ -34,4 +35,22 @@
3435

3536
end procedure
3637

38+
module procedure flag_value
39+
40+
integer argnum, arglen
41+
character(len=64) arg
42+
43+
flag_search: &
44+
do argnum = 1,command_argument_count()
45+
call get_command_argument(argnum, arg, arglen)
46+
if (arg==flag) then
47+
call assert(arglen<=len(arg), "flag_value: arglen<=len(arg)")
48+
allocate(character(len=arglen) :: flag_val)
49+
call get_command_argument(argnum+1, flag_val)
50+
exit flag_search
51+
end if
52+
end do flag_search
53+
54+
end procedure
55+
3756
end submodule

test/command_line_test.f90

Lines changed: 45 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,45 @@
1+
module command_line_test
2+
!! Verify object pattern asbtract parent
3+
use test_m, only : test_t, test_result_t
4+
use command_line_m, only : command_line_t
5+
implicit none
6+
7+
private
8+
public :: command_line_test_t
9+
10+
type, extends(test_t) :: command_line_test_t
11+
contains
12+
procedure, nopass :: subject
13+
procedure, nopass :: results
14+
end type
15+
16+
contains
17+
18+
pure function subject() result(specimen)
19+
character(len=:), allocatable :: specimen
20+
specimen = "The command_line_t type"
21+
end function
22+
23+
function results() result(test_results)
24+
type(test_result_t), allocatable :: test_results(:)
25+
26+
test_results = [ &
27+
test_result_t("returning the value passed after a command-line flag", check_flag_value()) &
28+
]
29+
end function
30+
31+
function check_flag_value() result(test_passes)
32+
logical test_passes
33+
34+
integer exit_status, command_status
35+
character(len=132) command_message
36+
37+
call execute_command_line( &
38+
command = "fpm run --example get-flag-value -- --input-file foo > /dev/null 2>&1", &
39+
wait = .true., exitstat = exit_status, cmdstat = command_status, cmdmsg = command_message &
40+
)
41+
test_passes = exit_status == 0
42+
43+
end function
44+
45+
end module command_line_test

test/main.f90

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,13 +4,15 @@ program main
44
use object_m_test, only : object_test_t
55
use formats_test, only : formats_test_t
66
use test_result_test, only : test_result_test_t
7+
use command_line_test, only : command_line_test_t
78
implicit none
89

910
type(collectives_test_t) collectives_test
1011
type(data_partition_test_t) data_partition_test
1112
type(formats_test_t) formats_test
1213
type(object_test_t) object_test
1314
type(test_result_test_t) test_result_test
15+
type(command_line_test_t) command_line_test
1416

1517
integer :: passes=0, tests=0
1618

@@ -19,6 +21,7 @@ program main
1921
call object_test%report(passes, tests)
2022
call formats_test%report(passes, tests)
2123
call test_result_test%report(passes, tests)
24+
call command_line_test%report(passes, tests)
2225

2326
print *
2427
print *,"_________ In total, ",passes," of ",tests, " tests pass. _________"

0 commit comments

Comments
 (0)