test(test_description_t): add unit test

Author: rouson

src/sourcery/sourcery_test_description_m.F90

@@ -25,18 +25,28 @@ function test_function_i() result(passes)
   contains
     procedure run
     procedure contains_text
+    generic :: operator(==) => equals
+    procedure, private :: equals
   end type
 
   interface test_description_t
 
-    module function construct(description, test_function) result(test_description)
+    module function construct_from_string_t(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
 
+    module function construct_from_character(description, test_function) result(test_description)
+      !! The result is a test_description_t object with the components defined by the dummy arguments
+      implicit none
+      character(len=*), intent(in) :: description
+      procedure(test_function_i), intent(in), pointer :: test_function
+      type(test_description_t) test_description
+    end function
+
   end interface
 
   interface
@@ -56,6 +66,13 @@ impure elemental module function contains_text(self, substring) result(match)
       logical match
     end function
 
+    elemental module function equals(lhs, rhs) result(lhs_eq_rhs)
+      !! The result is .true. if the components of the lhs & rhs are equal
+      implicit none
+      class(test_description_t), intent(in) :: lhs, rhs
+      logical lhs_eq_rhs
+    end function
+
   end interface
 
 end module sourcery_test_description_m

src/sourcery/sourcery_test_description_s.f90

@@ -1,9 +1,12 @@
 submodule(sourcery_test_description_m) sourcery_test_description_s
   implicit none
-
 contains
+    module procedure construct_from_character
+      test_description%description_ = description
+      test_description%test_function_ => test_function
+    end procedure
 
-    module procedure construct
+    module procedure construct_from_string_t
       test_description%description_ = description
       test_description%test_function_ => test_function
     end procedure
@@ -16,4 +19,7 @@
       match = index(self%description_%string(), substring%string()) /= 0
     end procedure
 
+    module procedure equals
+      lhs_eq_rhs = (lhs%description_ == rhs%description_) .and. associated(lhs%test_function_, rhs%test_function_)
+    end procedure
 end submodule sourcery_test_description_s

test/main.f90

@@ -1,23 +1,25 @@
 program main
-  use user_defined_collectives_test_m, only : collectives_test_t  
-  use data_partition_test_m, only : data_partition_test_t
   use bin_test_m, only : bin_test_t
-  use object_m_test_m, only : object_test_t  
-  use formats_test_m, only : formats_test_t  
-  use test_result_test_m, only : test_result_test_t  
   use command_line_test_m, only : command_line_test_t
+  use data_partition_test_m, only : data_partition_test_t
+  use formats_test_m, only : formats_test_t  
+  use object_m_test_m, only : object_test_t  
   use string_test_m, only : string_test_t
   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 user_defined_collectives_test_m, only : collectives_test_t  
   implicit none
 
+  type(bin_test_t) bin_test
+  type(command_line_test_t) command_line_test
   type(collectives_test_t) collectives_test
   type(data_partition_test_t) data_partition_test
-  type(bin_test_t) bin_test
   type(formats_test_t) formats_test
   type(object_test_t) object_test
-  type(test_result_test_t) test_result_test
-  type(command_line_test_t) command_line_test
   type(string_test_t) string_test
+  type(test_result_test_t) test_result_test
+  type(test_description_test_t) test_description_test
 
   integer :: passes=0, tests=0
 
@@ -34,19 +36,17 @@ program main
   end block
 
   call bin_test%report(passes, tests)
-  call data_partition_test%report(passes, tests)
   call collectives_test%report(passes, tests)
-  call object_test%report(passes, tests)
-  call test_result_test%report(passes, tests)
+  call data_partition_test%report(passes, tests)
   call formats_test%report(passes, tests)
+  call object_test%report(passes, tests)
   call string_test%report(passes, tests)
-
+  call test_result_test%report(passes, tests)
+  call 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. _________"
-
   if (passes /= tests) error stop
-
 contains
 
   logical function GitHub_CI()

test/test_description_test.F90

@@ -0,0 +1,65 @@
+module test_description_test_m
+  !! Verify test_description_t object behavior
+  use sourcery_m, only : string_t, test_result_t, test_description_t, test_t, test_description_substring
+#ifdef __GFORTRAN__
+  use sourcery_m, only : test_function_i
+#endif
+  implicit none
+
+  private
+  public :: test_description_test_t
+
+  type, extends(test_t) :: test_description_test_t
+  contains
+    procedure, nopass :: subject
+    procedure, nopass :: results
+  end type
+
+contains
+
+  pure function subject() result(specimen)
+    character(len=:), allocatable :: specimen
+    specimen = "The test_description_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("identical construction from string_t or character arguments", check_character_constructor) &
+    ]
+#else
+    ! Work around missing Fortran 2008 feature: associating a procedure actual argument with a procedure pointer dummy argument:
+    procedure(test_function_i), pointer :: check_character_ptr
+    check_character_ptr => check_character_constructor
+    test_descriptions = [ &
+      test_description_t("identical construction from string_t or character arguments", check_character_ptr) &
+    ]
+#endif
+    associate( &
+      substring_in_subject => index(subject(), test_description_substring) /= 0, &
+      substring_in_description => test_descriptions%contains_text(string_t(test_description_substring)) &
+    )
+      test_descriptions = pack(test_descriptions, substring_in_subject .or. substring_in_description)
+    end associate
+    test_results = test_descriptions%run()
+  end function
+
+  function check_character_constructor() result(passed)
+    logical passed
+#ifndef __GFORTRAN__
+    passed = test_description_t("foo", tautology) == test_description_t(string_t("foo"), tautology)
+#else
+    procedure(test_function_i), pointer :: test_function_ptr
+    test_function_ptr => tautology
+    passed = test_description_t("foo", test_function_ptr) == test_description_t(string_t("foo"), test_function_ptr)
+#endif
+  contains
+    logical function tautology()
+      tautology = .true. 
+    end function
+  end function
+
+end module test_description_test_m