feat: support vector-valued test functions

Author: rouson

src/sourcery/sourcery_test_description_m.F90 renamed to src/sourcery/sourcery_test_description_m.f90

@@ -6,9 +6,7 @@ module sourcery_test_description_m
 
   private
   public :: test_description_t
-#ifdef __GFORTRAN__
   public :: test_function_i
-#endif
 
   abstract interface
     function test_function_i() result(passes)

src/sourcery/sourcery_test_result_m.f90

@@ -8,12 +8,13 @@ module sourcery_test_result_m
 
   type test_result_t
     !! Encapsulate test descriptions and outcomes
-    private
+    !private
     type(string_t) description_
     logical passed_ 
   contains
     procedure :: characterize
     procedure :: passed
+    procedure :: description_contains
   end type
 
   interface test_result_t
@@ -26,7 +27,7 @@ elemental module function construct_from_character(description, passed) result(t
       type(test_result_t) test_result 
     end function
 
-    module function construct_from_string(description, passed) result(test_result)
+    elemental 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
@@ -52,6 +53,14 @@ impure elemental module function passed(self) result(test_passed)
       logical test_passed
     end function
 
+    elemental module function description_contains(self, substring) result(substring_found)
+      !! The result is true if and only if the test description contains the substring
+      implicit none
+      class(test_result_t), intent(in) :: self
+      type(string_t), intent(in) :: substring
+      logical substring_found
+    end function
+
   end interface
 
 end module sourcery_test_result_m

src/sourcery/sourcery_test_result_s.f90

@@ -23,4 +23,8 @@
       call co_all(test_passed)
     end procedure
 
+    module procedure description_contains
+      substring_found = index(self%description_%string(), substring%string()) /= 0
+    end procedure
+
 end submodule sourcery_test_result_s

src/sourcery/sourcery_test_s.F90

@@ -11,17 +11,18 @@
 
       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.)"
+            print*,"Running all tests."
+            print*,"(Add '-- --contains <string>' to run only tests with subjects or descriptions containing the specified string.)"
           else
-            print *,"Running only tests with descriptions containing '", test_description_substring,"'."
+            print *,"Running only tests with subjects or descriptions containing '", test_description_substring,"'."
           end if
         end if first_report
 

src/sourcery/sourcery_vector_test_description_m.f90

@@ -0,0 +1,89 @@
+module sourcery_vector_test_description_m
+  !! Define an abstraction for describing test intentions and array-valued test functions
+  use sourcery_string_m, only : string_t
+  use sourcery_test_result_m, only : test_result_t
+  use assert_m, only : assert
+  implicit none
+
+  private
+  public :: vector_test_description_t
+  public :: vector_function_strategy_t
+
+  abstract interface
+    function vector_function_i() result(passes)
+      implicit none
+      logical, allocatable :: passes(:)
+    end function
+  end interface
+
+  type, abstract :: vector_function_strategy_t
+  contains
+    procedure(vector_function_i), deferred, nopass ::  vector_function
+  end type
+
+  type vector_test_description_t
+    !! Encapsulate test descriptions and vector-valued test functions
+    private
+    type(string_t), allocatable :: description_vector_(:)
+    class(vector_function_strategy_t), allocatable :: vector_function_strategy_
+  contains
+    procedure run
+    procedure contains_text
+  end type
+
+  interface vector_test_description_t
+
+    module function construct(description_vector, vector_function_strategy) result(vector_test_description)
+     !! The result is a vector_test_description_t object with the components defined by the dummy arguments
+      implicit none
+      type(string_t), intent(in) :: description_vector(:)
+      class(vector_function_strategy_t), intent(in) :: vector_function_strategy
+      type(vector_test_description_t) vector_test_description
+    end function
+
+  end interface
+
+  interface
+
+    impure module function run(self) result(test_results)
+      !! The result encapsulates the test description and test outcome
+      implicit none
+      class(vector_test_description_t), intent(in) :: self
+      type(test_result_t), allocatable :: test_results(:)
+    end function
+
+    module function contains_text(self, substring) result(match_vector)
+      !! The result is .true. if the test description includes the value of substring 
+      implicit none
+      class(vector_test_description_t), intent(in) :: self
+      character(len=*), intent(in) :: substring
+      logical, allocatable :: match_vector(:)
+    end function
+
+  end interface
+
+contains
+
+  module procedure contains_text
+    integer i
+    associate(num_descriptions => size(self%description_vector_))
+      allocate(match_vector(num_descriptions))
+      do i = 1, num_descriptions
+        match_vector(i) = index(self%description_vector_(i)%string(), substring ) /= 0
+      end do
+    end associate
+  end procedure
+
+  module procedure construct
+    vector_test_description%description_vector_ = description_vector
+    vector_test_description%vector_function_strategy_ = vector_function_strategy
+  end procedure
+
+  module procedure run
+    associate(vector_result => self%vector_function_strategy_%vector_function())
+      call assert(size(self%description_vector_)==size(vector_result), "sourcery_vector_test_description_s: size match")
+      test_results = test_result_t(self%description_vector_, vector_result)
+    end associate
+  end procedure
+
+end module sourcery_vector_test_description_m

src/sourcery_m.F90

@@ -7,11 +7,9 @@ module sourcery_m
   use sourcery_file_m, only : file_t
   use sourcery_string_m, only : string_t, operator(.cat.)
   use sourcery_test_m, only : test_t, test_description_substring
-  use sourcery_test_description_m, only : test_description_t
-#ifdef __GFORTRAN__
-  use sourcery_test_description_m, only : test_function_i
-#endif
+  use sourcery_test_description_m, only : test_description_t, test_function_i
   use sourcery_test_result_m, only : test_result_t
+  use sourcery_vector_test_description_m, only : vector_test_description_t, vector_function_strategy_t
   use sourcery_user_defined_collectives_m, only : co_all
 
   !! legacy modules (likely to be removed in a future release):

test/main.f90

@@ -8,6 +8,7 @@ program main
   use sourcery_m, only : command_line_t
   use test_result_test_m, only : test_result_test_t  
   use test_description_test_m, only : test_description_test_t  
+  use vector_test_description_test_m, only : vector_test_description_test_t  
   use user_defined_collectives_test_m, only : collectives_test_t  
   implicit none
 
@@ -20,6 +21,7 @@ program main
   type(string_test_t) string_test
   type(test_result_test_t) test_result_test
   type(test_description_test_t) test_description_test
+  type(vector_test_description_test_t) vector_test_description_test
 
   integer :: passes=0, tests=0
 
@@ -43,6 +45,7 @@ program main
   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 (this_image()==1) print *, new_line('a'), "_________ In total, ",passes," of ",tests, " tests pass. _________"

test/vector_test_description_test.f90

@@ -0,0 +1,55 @@
+module vector_test_description_test_m
+  !! Verify vector_test_description_t object behavior
+  use sourcery_m, only : &
+    string_t, test_result_t, vector_test_description_t, test_t, test_description_substring, vector_function_strategy_t
+  implicit none
+
+  private
+  public :: vector_test_description_test_t
+
+  type, extends(test_t) :: vector_test_description_test_t
+  contains
+    procedure, nopass :: subject
+    procedure, nopass :: results
+  end type
+
+  type, extends(vector_function_strategy_t) :: two_vector_tautology_t
+  contains
+    procedure, nopass :: vector_function
+  end type
+
+contains
+
+  pure function subject() result(specimen)
+    character(len=:), allocatable :: specimen
+    specimen = "The vector_test_description_t type" 
+  end function
+
+  function vector_function() result(passed)
+    logical, allocatable :: passed(:)
+    passed = [.true., .true.]
+  end function
+
+  function results() result(test_results)
+    type(test_result_t), allocatable :: test_results(:)
+    type(two_vector_tautology_t) two_vector_tautology
+
+    associate( &
+      vector_test_description => vector_test_description_t([string_t("construction"),string_t("assignment")], two_vector_tautology)&
+    )
+      associate(substring_in_subject => index(subject(), test_description_substring) /= 0)
+        associate(substring_in_description => vector_test_description%contains_text(test_description_substring))
+        if (substring_in_subject) then
+          test_results = vector_test_description%run()
+        else if (any(substring_in_description)) then
+          test_results = vector_test_description%run()
+          test_results = pack(test_results, test_results%description_contains(string_t(test_description_substring)))
+         else
+          test_results = [test_result_t::]
+        end if
+        end associate
+      end associate
+    end associate
+  end function
+
+end module vector_test_description_test_m