refac(test_descrip): elemental test_result factory

Author: rouson

src/sourcery/sourcery_test_description_m.F90

@@ -0,0 +1,52 @@
+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
+  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
+
+  end interface
+
+end module sourcery_test_description_m

src/sourcery/sourcery_test_description_s.f90

@@ -0,0 +1,15 @@
+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
+
+end submodule sourcery_test_description_s

src/sourcery/sourcery_test_result_m.f90

@@ -18,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,7 +4,12 @@
 
 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

test/test_result_test.F90

@@ -0,0 +1,71 @@
+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_description_m, only : test_description_t
+#ifdef __GFORTRAN__
+  use sourcery_test_description_m, only : test_function_i
+#endif
+  implicit none
+
+  private
+  public :: test_result_test_t
+
+  type, extends(test_t) :: test_result_test_t
+  contains
+    procedure, nopass :: subject
+    procedure, nopass :: results
+  end type
+
+contains
+
+  pure function subject() result(specimen)
+    character(len=:), allocatable :: specimen
+    specimen = "The test_result_t type" 
+  end function
+
+  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) &
+      test_description_t(string_t("reporting failure if the test fails on one image"), check_single_image_failure) &
+    ]
+#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()
+  end function
+
+  function check_array_result_construction() result(passed)
+    type(test_result_t), allocatable :: test_results(:)
+    logical passed
+
+    test_results = test_result_t(["foo","bar"], [.true.,.false.])
+    passed = size(test_results)==2
+  end function
+
+  function check_single_image_failure() result(passed)
+    type(test_result_t), allocatable :: test_result
+    logical passed
+
+    if (this_image()==1) then
+      test_result = test_result_t("image 1 fails", .false.)
+    else
+      test_result = test_result_t("all images other than 1 pass", .true.)
+    end if
+
+    passed = .not. test_result%passed()
+  end function
+
+end module test_result_test_m