Merge pull request #36 from sourceryinstitute/command-line-flag

feat(commmand_line): extract flag value & test

Author: rouson

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

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(<longest_argument>)):: "--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

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

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

test/main.f90

@@ -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
 
@@ -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. _________"