Merge pull request #26 from BerkeleyLab/fix-commmand-line-tests

test(command_line_t): improve robustness

.github/workflows/CI.yml

@@ -7,7 +7,7 @@ jobs:
     runs-on: ${{ matrix.os }}
     strategy:
       matrix:
-        os: [macos-12, ubuntu-24.04]
+        os: [macos-13, ubuntu-24.04]
 
     steps:
     - name: Checkout code

.gitignore

@@ -1,3 +1,4 @@
+*.smod
 *.mod
 *.o
 a.out

src/julienne/julienne_command_line_m.f90

@@ -26,7 +26,8 @@ module function argument_present(acceptable_argument) result(found)
     end function
 
     module function flag_value(flag)
-      !! result is the value passed adjacent to a command-line flag
+      !! result = { the value passed immediately after a command-line flag if the flag is present or
+      !!          { an empty string otherwise.
       implicit none
       character(len=*), intent(in) :: flag
       character(len=:), allocatable :: flag_value

src/julienne/julienne_command_line_s.f90

@@ -18,8 +18,6 @@
 
     associate(acceptable_length => [(len(trim(acceptable_argument(i))), i = 1, size(acceptable_argument))])
 
-      found = .false.
-
       do argnum = 1,command_argument_count()
 
         call get_command_argument(argnum, arg, arglen)
@@ -28,42 +26,34 @@
           [(arg==acceptable_argument(i) .and. arglen==acceptable_length(i), i = 1, size(acceptable_argument))] &
         )) then
           found = .true.
+          return
         end if
 
       end do
 
+      found = .false.
+
     end associate
 
   end procedure
 
   module procedure flag_value
-
     integer argnum, arglen, flag_value_length
     character(len=:), allocatable :: arg
 
-    associate(argcount => command_argument_count())
-      if (argcount==0) then
-        flag_value=""
-      else
-        flag_search: &
-        do argnum = 1,argcount
-
-          if (allocated(arg)) deallocate(arg)
-
-          call get_command_argument(argnum, length=arglen)
-          allocate(character(len=arglen) :: arg)
-          call get_command_argument(argnum, arg)
-
-          if (arg==flag) then
-            call get_command_argument(argnum+1, length=flag_value_length)
-            allocate(character(len=flag_value_length) :: flag_value)
-            call get_command_argument(argnum+1, flag_value)
-            exit flag_search
-          end if
-        end do flag_search
+    do argnum = 1,command_argument_count()-1
+      call get_command_argument(argnum, length=arglen)
+      allocate(character(len=arglen) :: arg)
+      call get_command_argument(argnum, arg)
+      if (arg==flag) then
+        call get_command_argument(argnum+1, length=flag_value_length)
+        allocate(character(len=flag_value_length) :: flag_value)
+        call get_command_argument(argnum+1, flag_value)
+        return
       end if
-    end associate
-
+      deallocate(arg)
+    end do
+    flag_value=""
   end procedure
 
 end submodule

src/julienne/julienne_test_m.f90 → src/julienne/julienne_test_m.F90

@@ -1,10 +1,16 @@
 ! Copyright (c) 2024, The Regents of the University of California and Sourcery Institute
 ! Terms of use are as specified in LICENSE.txt
+
+#include "language-support.F90"
+
 module julienne_test_m
   !! Define an abstract test_t type with deferred bindings ("subject" and "results")
   !! used by a type-bound procedure ("report") for reporting test results.  The "report"
   !! procedure thus represents an implementation of the Template Method pattern.
   use julienne_test_result_m, only : test_result_t
+  use julienne_user_defined_collectives_m, only : co_all
+  use julienne_command_line_m, only : command_line_t
+
   implicit none
 
   private

src/julienne/julienne_test_s.F90

@@ -1,16 +1,12 @@
 ! Copyright (c) 2024, The Regents of the University of California and Sourcery Institute
 ! Terms of use are as specified in LICENSE.txt
-
-#include "language-support.F90"
-
 submodule(julienne_test_m) julienne_test_s
-  use julienne_user_defined_collectives_m, only : co_all
-  use julienne_command_line_m, only : command_line_t
   implicit none
 
 contains
 
   module procedure report
+
 #if HAVE_MULTI_IMAGE_SUPPORT
     associate(me => this_image())
 #else
@@ -22,7 +18,7 @@
 
         first_report: &
         if (.not. allocated(test_description_substring)) then
-          block 
+          block
             type(command_line_t) command_line
             test_description_substring = command_line%flag_value("--contains")
           end block
@@ -42,7 +38,7 @@
 #if HAVE_MULTI_IMAGE_SUPPORT
       call co_broadcast(test_description_substring, source_image=1)
 #endif
-      
+
 #ifndef _CRAYFTN
       associate(test_results => test%results())
         associate(num_tests => size(test_results))
@@ -55,7 +51,7 @@
               end do
             end block
           end if
-          block 
+          block
             logical, allocatable :: passing_tests(:)
             passing_tests = test_results%passed()
             call co_all(passing_tests)

test/command_line_test.F90

@@ -33,20 +33,33 @@ function results() result(test_results)
     type(test_description_t), allocatable :: test_descriptions(:)
 #if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY
     test_descriptions = [ & 
-      test_description_t(string_t("returning the value passed after a command-line flag"), check_flag_value), &
-      test_description_t(string_t("returning an empty string when a flag value is missing"), handle_missing_flag_value), &
-      test_description_t(string_t("detecting a present command-line argument"), check_command_line_argument) &
+       test_description_t(string_t("flag_value() result is the value passed after a command-line flag"), check_flag_value) &
+      ,test_description_t(string_t("flag_value() result is an empty string if command-line flag value is missing"), check_flag_value_missing) &
+      ,test_description_t(string_t("flag_value() result is an empty string if command-line flag is missing"), check_flag_missing) &
+      ,test_description_t(string_t("argument_present() result is .false. if a command-line argument is missing"), check_argument_missing) &
+      ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present"), check_argument_present) &
     ]   
 #else
     ! Work around missing Fortran 2008 feature: associating a procedure actual argument with a procedure pointer dummy argument:
-    procedure(test_function_i), pointer :: check_flag_ptr, handle_missing_value_ptr, check_command_ptr
-    check_flag_ptr => check_flag_value 
-    handle_missing_value_ptr => handle_missing_flag_value
-    check_command_ptr => check_command_line_argument
+    procedure(test_function_i), pointer :: &
+       check_flag_value_ptr &
+      ,check_flag_value_missing_ptr &
+      ,check_flag_missing_ptr &
+      ,check_argument_missing_ptr &
+      ,check_argument_present_ptr 
+
+      check_flag_value_ptr         => check_flag_value
+      check_flag_value_missing_ptr => check_flag_value_missing
+      check_flag_missing_ptr       => check_flag_missing
+      check_argument_missing_ptr   => check_argument_missing
+      check_argument_present_ptr   => check_argument_present
+
     test_descriptions = [ & 
-      test_description_t(string_t("returning the value passed after a command-line flag"), check_flag_ptr), &
-      test_description_t(string_t("returning an empty string when a flag value is missing"), handle_missing_value_ptr), &
-      test_description_t(string_t("detecting a present command-line argument"), check_command_ptr) &
+       test_description_t(string_t("flag_value() result is the value passed after a command-line flag"), check_flag_value_ptr) &
+      ,test_description_t(string_t("flag_value() result is an empty string if command-line flag value is missing"), check_flag_value_missing_ptr) &
+      ,test_description_t(string_t("flag_value() result is an empty string if command-line flag is missing"), check_flag_missing_ptr) &
+      ,test_description_t(string_t("argument_present() result is .false. if a command-line argument is missing"), check_argument_missing_ptr) &
+      ,test_description_t(string_t("argument_present() result is .true. if a command-line argument is present"), check_argument_present_ptr) &
     ]   
 #endif
     test_descriptions = pack(test_descriptions, &
@@ -57,38 +70,32 @@ function results() result(test_results)
 
   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 some_file_name", &
-      wait = .true., exitstat = exit_status, cmdstat = command_status, cmdmsg = command_message &
-    )   
-    test_passes = exit_status == 0 
+    type(command_line_t) command_line
+    test_passes = command_line%flag_value("--test") == "command_line_t"
   end function
 
-  function handle_missing_flag_value() result(test_passes)
+  function check_flag_value_missing() result(test_passes)
     logical test_passes
-    integer exit_status, command_status
-    character(len=132) command_message
+    type(command_line_t) command_line
+    test_passes = command_line%flag_value("--type") == ""
+  end function
 
-    call execute_command_line( &
-      command = "fpm run --example handle-missing-flag -- --empty-flag", &
-      wait = .true., exitstat = exit_status, cmdstat = command_status, cmdmsg = command_message &
-    )   
-    test_passes = exit_status == 0 
+  function check_flag_missing() result(test_passes)
+    logical test_passes
+    type(command_line_t) command_line
+    test_passes = command_line%flag_value("r@nd0m.Junk-H3R3") == ""
   end function
 
-  function check_command_line_argument() result(test_passes)
+  function check_argument_missing() result(test_passes)
     logical test_passes
-    integer exit_status, command_status
-    character(len=132) command_message
+    type(command_line_t) command_line
+    test_passes = .not. command_line%argument_present(["M1ss1ng-argUment"])
+  end function
 
-    call execute_command_line( &
-      command = "fpm run --example check-command-line-argument -- --some-argument", &
-      wait = .true., exitstat = exit_status, cmdstat = command_status, cmdmsg = command_message &
-    )
-    test_passes = exit_status == 0
+  function check_argument_present() result(test_passes)
+    logical test_passes
+    type(command_line_t) command_line
+    test_passes = command_line%argument_present(["--type"])
   end function
 
 end module command_line_test_m

test/main.F90

@@ -27,27 +27,40 @@ program main
   type(test_description_test_t) test_description_test
   type(vector_test_description_test_t) vector_test_description_test
 
+  type(command_line_t) command_line
+
   integer :: passes=0, tests=0
 
-  block 
-    type(command_line_t) command_line
-    character(len=*), parameter :: usage = &
-      new_line('') // new_line('') // &
-      'Usage: fpm test -- [--help] | [--contains <substring>]' // &
-      new_line('') // new_line('') // &
-      'where square brackets ([]) denote optional arguments, a pipe (|) separates alternative arguments,' // new_line('') // &
-      'angular brackets (<>) denote a user-provided value, and passing a substring limits execution to' // new_line('') // &
-      'the tests with test subjects or test descriptions containing the user-specified substring.' // new_line('') 
-    if (command_line%argument_present([character(len=len("--help"))::"--help","-h"])) stop usage
-  end block
+  character(len=*), parameter :: usage = &
+    new_line('') // new_line('') // &
+    'Usage: fpm test -- [--help] | [--contains <substring>]' // &
+    new_line('') // new_line('') // &
+    'where square brackets ([]) denote optional arguments, a pipe (|) separates alternative arguments,' // new_line('') // &
+    'angular brackets (<>) denote a user-provided value, and passing a substring limits execution to' // new_line('') // &
+    'the tests with test subjects or test descriptions containing the user-specified substring.' // new_line('') 
+
+  if (command_line%argument_present([character(len=len("--help"))::"--help","-h"])) stop usage
+
+  print "(a)", new_line("") // "Append '-- --help' or '-- -h' to your `fpm test` command to display usage information."
 
   call bin_test%report(passes, tests)
   call formats_test%report(passes, tests)
   call string_test%report(passes, tests)
   call test_result_test%report(passes, tests)
   call test_description_test%report(passes, tests)
   call vector_test_description_test%report(passes,tests)
-  if (.not. GitHub_CI())  call command_line_test%report(passes, tests)
+
+  if (.not. GitHub_CI())  then
+    if (command_line%argument_present(["--test"])) then
+      call command_line_test%report(passes, tests)
+    else
+      write(*,"(a)")  &
+      new_line("") // &
+      "To also test Julienne's command_line_t type, append the following to your fpm test command:" // &
+      new_line("") // &
+      "-- --test command_line_t --type"
+    end if
+  end if
 
 #if HAVE_MULTI_IMAGE_SUPPORT
   if (this_image()==1) then