From 5ba6896538f8fb92a263beac3825d26712e1b97b Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Tue, 11 Oct 2022 15:32:06 -0700 Subject: [PATCH] feat(commmand_line): extract flag value & test --- example/get-flag-value.f90 | 20 +++++++++++++++++ src/command_line_m.f90 | 9 ++++++++ src/command_line_s.f90 | 19 ++++++++++++++++ test/command_line_test.f90 | 45 ++++++++++++++++++++++++++++++++++++++ test/main.f90 | 3 +++ 5 files changed, 96 insertions(+) create mode 100644 example/get-flag-value.f90 create mode 100644 test/command_line_test.f90 diff --git a/example/get-flag-value.f90 b/example/get-flag-value.f90 new file mode 100644 index 00000000..0c7e5fc1 --- /dev/null +++ b/example/get-flag-value.f90 @@ -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 diff --git a/src/command_line_m.f90 b/src/command_line_m.f90 index f89a2c3b..d3fdedf0 100644 --- a/src/command_line_m.f90 +++ b/src/command_line_m.f90 @@ -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()):: "--benchmark", "-b", "/benchmark", "/b"] @@ -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 diff --git a/src/command_line_s.f90 b/src/command_line_s.f90 index 3a98725e..ee95755c 100644 --- a/src/command_line_s.f90 +++ b/src/command_line_s.f90 @@ -1,4 +1,5 @@ submodule(command_line_m) command_line_s + use assert_m, only : assert implicit none contains @@ -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 diff --git a/test/command_line_test.f90 b/test/command_line_test.f90 new file mode 100644 index 00000000..e92973dc --- /dev/null +++ b/test/command_line_test.f90 @@ -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 diff --git a/test/main.f90 b/test/main.f90 index d01fcf8b..c67690c7 100644 --- a/test/main.f90 +++ b/test/main.f90 @@ -4,6 +4,7 @@ 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 @@ -11,6 +12,7 @@ program main 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 @@ -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. _________"