Merge pull request #76 from sourceryinstitute/run-tests-selectively

Run tests selectively

Author: rouson

README.md

@@ -1,7 +1,7 @@
 Sourcery Library
 ================
 
-A grab bag of useful tricks in Fortran 2018.  
+A grab bag of useful tricks in Fortran 2023.  
 
 ```fortran
                       -:/+-
@@ -82,6 +82,16 @@ git clone [email protected]:sourceryinstitute/sourcery
 
 Building and Testing
 --------------------
+### Test-Suite Usage
+Executing `fpm test -- --help` prints the following message:
+```
+Usage: fpm test -- [--help] | [--contains <substring>]
+
+where square brackets ([]) denote optional arguments, a pipe (|) separates alternative arguments,
+angular brackets (<>) denote a user-provided value, and passing a substring limits execution to
+the tests with test subjects or test descriptions containing the user-specified substring.
+```
+
 ### Single-image (serial) testing with GNU Fortran (`gfortran`) 
 With recent versions of [GNU Fortran] (gfortran) and [OpenCoarrays] installed, 
 execute the following command in a `zsh` or `bash`-like shell:
@@ -99,7 +109,7 @@ Substitute the desired number of images for the `4` above.
 
 ### Testing with the Numerical Algorithms Group (`nagfor`) compiler
 ```zsh
-fpm test --compiler nagfor --flag "-fpp -coarray=cosmp"
+fpm test --compiler nagfor --flag -fpp
 ```
 
 ### Building and testing with the Cray Compiler Environment (CCE)
@@ -147,4 +157,3 @@ documentation.
 [Building the documentation]: #building-the-documentation
 [Sourcery GitHub Pages site]: http://sourceryinstitute.github.io/sourcery/
 [`ford`]: https://github.com/Fortran-FOSS-Programmers/ford
-

example/check-command-line-argument.f90

@@ -0,0 +1,22 @@
+program check_command_line_argument
+  !! This program serves the dual purposes of 
+  !! 1. Showing how to use the command_line_t derived type to check whether a
+  !!    command-line argument is present and
+  !! 2. Supporting the test suite verification of this same behavior.
+  !!
+  !! Running this program as follows with the command
+  !!
+  !! fpm run --example check-command-line-argument -- --some-argument 
+  !!
+  !! should result in normal termination.
+  use assert_m, only : assert
+  use sourcery_m, only : command_line_t
+  implicit none
+
+  type(command_line_t) command_line
+  logical argument_passed
+
+  argument_passed = command_line%argument_present(["--some-argument"])
+
+  call assert(argument_passed, "check_command_line_argument: argument present")
+end program

example/handle-missing-flag.f90

@@ -0,0 +1,23 @@
+program handle_missing_flag
+  !! This program serves the dual purposes of
+  !!
+  !! 1. Showing an example of a command-line with an expected flag missing an
+  !! 2. Supporting the test suite check that the returned value has zero length.
+  !!
+  !! Running this program as follows with the command
+  !!
+  !! fpm run --example handle-missing-flag -- --empty-flag
+  !!
+  !! should result in normal termination.
+  use assert_m, only : assert
+  use sourcery_m, only : command_line_t
+  implicit none
+
+  type(command_line_t) command_line
+  character(len=:), allocatable :: flag_value
+  character(len=*), parameter :: expected_name=""
+
+  flag_value = command_line%flag_value("--empty-flag")
+
+  call assert(flag_value==expected_name,"handle_missing_flag: expected empty flag value", flag_value)
+end program

src/sourcery/sourcery_command_line_s.f90

@@ -39,23 +39,28 @@
     integer argnum, arglen, flag_value_length
     character(len=:), allocatable :: arg
 
-
-    flag_search: &
-    do argnum = 1,command_argument_count()
-
-      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
+    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
       end if
-    end do flag_search
+    end associate
 
   end procedure
 

src/sourcery/sourcery_test_description_m.F90

@@ -0,0 +1,61 @@
+module sourcery_test_description_m
+  !! Define an abstraction for describing test intentions and test functions
+  use sourcery_string_m, only : string_t
+  use sourcery_test_result_m, only : test_result_t
+  implicit none
+
+  private
+  public :: test_description_t
+#ifdef __GFORTRAN__
+  public :: test_function_i
+#endif
+
+  abstract interface
+    function test_function_i() result(passes)
+      implicit none
+      logical passes
+    end function
+  end interface
+
+  type test_description_t
+    !! Encapsulate test descriptions and test-functions
+    private
+    type(string_t) description_
+    procedure(test_function_i), pointer, nopass :: test_function_ => null()
+  contains
+    procedure run
+    procedure contains_text
+  end type
+
+  interface test_description_t
+
+    module function construct(description, test_function) result(test_description)
+      !! The result is a test_description_t object with the components defined by the dummy arguments
+      implicit none
+      type(string_t), intent(in) :: description
+      procedure(test_function_i), intent(in), pointer :: test_function
+      type(test_description_t) test_description
+    end function
+
+  end interface
+
+  interface
+
+    impure elemental module function run(self) result(test_result)
+      !! The result encapsulates the test description and test outcome
+      implicit none
+      class(test_description_t), intent(in) :: self
+      type(test_result_t) test_result
+    end function
+
+    impure elemental module function contains_text(self, substring) result(match)
+      !! The result is .true. if the test description includes the value of substring 
+      implicit none
+      class(test_description_t), intent(in) :: self
+      type(string_t), intent(in) :: substring
+      logical match
+    end function
+
+  end interface
+
+end module sourcery_test_description_m

src/sourcery/sourcery_test_description_s.f90

@@ -0,0 +1,19 @@
+submodule(sourcery_test_description_m) sourcery_test_description_s
+  implicit none
+
+contains
+
+    module procedure construct
+      test_description%description_ = description
+      test_description%test_function_ => test_function
+    end procedure
+
+    module procedure run
+      test_result = test_result_t(self%description_, self%test_function_())
+    end procedure
+
+    module procedure contains_text
+      match = index(self%description_%string(), substring%string()) /= 0
+    end procedure
+
+end submodule sourcery_test_description_s

src/sourcery/sourcery_test_m.f90

@@ -6,7 +6,9 @@ module sourcery_test_m
   implicit none
 
   private
-  public :: test_t, test_result_t
+  public :: test_t, test_description_substring
+
+  character(len=:), allocatable, protected :: test_description_substring
 
   type, abstract :: test_t
     !! Facilitate testing and test reporting

src/sourcery/sourcery_test_result_m.f90

@@ -1,14 +1,15 @@
 module sourcery_test_result_m
   !! Define an abstraction for describing test intentions and results
+  use sourcery_string_m, only : string_t
   implicit none
 
   private
   public :: test_result_t
 
   type test_result_t
-    !! Encapsulate test descriptions and outcomes and reporting
+    !! Encapsulate test descriptions and outcomes
     private
-    character(len=:), allocatable :: description_
+    type(string_t) description_
     logical passed_ 
   contains
     procedure :: characterize
@@ -17,14 +18,22 @@ module sourcery_test_result_m
 
   interface test_result_t
 
-    elemental module function construct(description, passed) result(test_result)
+    elemental module function construct_from_character(description, passed) result(test_result)
       !! The result is a test_result_t object with the components defined by the dummy arguments
       implicit none
       character(len=*), intent(in) :: description
       logical, intent(in) :: passed
       type(test_result_t) test_result 
     end function
 
+    module function construct_from_string(description, passed) result(test_result)
+      !! The result is a test_result_t object with the components defined by the dummy arguments
+      implicit none
+      type(string_t), intent(in) :: description
+      logical, intent(in) :: passed
+      type(test_result_t) test_result 
+    end function
+
   end interface
 
   interface

src/sourcery/sourcery_test_result_s.f90

@@ -4,13 +4,18 @@
 
 contains
 
-    module procedure construct
+    module procedure construct_from_character
+      test_result%description_ = description
+      test_result%passed_ = passed
+    end procedure
+
+    module procedure construct_from_string
       test_result%description_ = description
       test_result%passed_ = passed
     end procedure
 
     module procedure characterize
-      characterization = trim(merge("passes on ", "FAILS on  ", self%passed_)) // " " // trim(self%description_) // "."
+      characterization = trim(merge("passes on ", "FAILS on  ", self%passed_)) // " " // trim(self%description_%string()) // "."
     end procedure
 
     module procedure passed

src/sourcery/sourcery_test_s.F90

@@ -1,14 +1,36 @@
 submodule(sourcery_test_m) sourcery_test_s
   use sourcery_user_defined_collectives_m, only : co_all
+  use sourcery_command_line_m, only : command_line_t
   implicit none
 
 contains
 
   module procedure report
 
     associate(me => this_image())
-      if (me==1) print *, new_line('a'), test%subject()
 
+      if (me==1) then
+
+        first_report: &
+        if (.not. allocated(test_description_substring)) then
+          block 
+            type(command_line_t) command_line
+            test_description_substring = command_line%flag_value("--contains")
+          end block
+          if (len(test_description_substring)==0) then
+            print *,"Running all tests."
+            print *,"(Add '-- --contains <string> to run only tests with descriptions containing the specified string.)"
+          else
+            print *,"Running only tests with descriptions containing '", test_description_substring,"'."
+          end if
+        end if first_report
+
+        print *, new_line('a'), test%subject()
+
+      end if
+
+      call co_broadcast(test_description_substring, source_image=1)
+      
 #ifndef _CRAYFTN
       associate(test_results => test%results())
         associate(num_tests => size(test_results))