feat(test): select tests by description substring

Author: rouson

src/sourcery/sourcery_test_description_m.F90

@@ -24,6 +24,7 @@ function test_function_i() result(passes)
     procedure(test_function_i), pointer, nopass :: test_function_ => null()
   contains
     procedure run
+    procedure contains_text
   end type
 
   interface test_description_t
@@ -47,6 +48,14 @@ impure elemental module function run(self) result(test_result)
       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

@@ -12,4 +12,8 @@
       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_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))

src/sourcery_m.f90

@@ -7,7 +7,7 @@ module sourcery_m
   use sourcery_file_m, only : file_t
   use sourcery_string_m, only : string_t, operator(.cat.)
   use sourcery_test_result_m, only : test_result_t
-  use sourcery_test_m, only : test_t
+  use sourcery_test_m, only : test_t, test_description_substring
   use sourcery_user_defined_collectives_m, only : co_all
 
   !! legacy modules (likely to be removed in a future release):

test/test_result_test.F90

@@ -1,8 +1,9 @@
 module test_result_test_m
   !! Verify test_result_t object behavior
   use sourcery_string_m, only : string_t
-  use sourcery_test_m, only : test_t, test_result_t
+  use sourcery_test_result_m, only : test_result_t
   use sourcery_test_description_m, only : test_description_t
+  use sourcery_test_m, only : test_t, test_description_substring
 #ifdef __GFORTRAN__
   use sourcery_test_description_m, only : test_function_i
 #endif
@@ -27,6 +28,7 @@ pure function subject() result(specimen)
   function results() result(test_results)
     type(test_result_t), allocatable :: test_results(:)
     type(test_description_t), allocatable :: test_descriptions(:)
+
 #ifndef __GFORTRAN__
     test_descriptions = [ &
       test_description_t(string_t("constructing an array of test_result_t objects elementally"), check_array_result_construction) &
@@ -35,16 +37,15 @@ function results() result(test_results)
 #else
     ! Work around missing Fortran 2008 feature: associating a procedure actual argument with a procedure pointer dummy argument:
     procedure(test_function_i), pointer :: check_array_ptr, check_single_ptr
-
     check_array_ptr => check_array_result_construction
     check_single_ptr => check_single_image_failure
-
     test_descriptions = [ &
       test_description_t(string_t("constructing an array of test_result_t objects elementally"), check_array_ptr), &
       test_description_t(string_t("reporting failure if the test fails on one image"), check_single_ptr) &
     ]
 #endif
-     test_results = test_descriptions%run()
+    test_descriptions = pack(test_descriptions, test_descriptions%contains_text(string_t(test_description_substring)))
+    test_results = test_descriptions%run()
   end function
 
   function check_array_result_construction() result(passed)