test(assert): call assert interf w/test_diag expr

Author: rouson

src/julienne/julienne_assertion_diagnosis_s.f90

@@ -0,0 +1,19 @@
+submodule (julienne_test_diagnosis_m) julienne_assertion_diagnosis_s
+  use assert_m, only : assert_library_assert => assert
+  implicit none
+
+contains
+
+  module procedure construct_from_components
+    assertion_diagnosis%test_diagnosis_t = test_diagnosis_t(success, diagnostics_string)
+  end procedure
+
+  module procedure construct_with_string
+    assertion_diagnosis%test_diagnosis_t = test_diagnosis_t(success, diagnostics_string%string())
+  end procedure
+
+  module procedure julienne_assert
+    call assert_library_assert(test_diagnosis%test_passed_, test_diagnosis%diagnostics_string_)
+  end procedure
+
+end submodule

src/julienne/julienne_assertion_s.f90

@@ -56,19 +56,29 @@ module julienne_test_diagnosis_m
 
   interface assertion_diagnosis_t
 
-    pure module function construct_from_parent(test_diagnosis) result(assertion_diagnosis)
+    pure module function construct_from_components(success, diagnostics_string) result(assertion_diagnosis)
       implicit none
-      type(test_diagnosis_t), intent(in) :: test_diagnosis
+      logical, intent(in) :: success
+      character(len=*), intent(in) :: diagnostics_string
+      type(assertion_diagnosis_t) assertion_diagnosis
+    end function
+
+    pure module function construct_with_string(success, diagnostics_string) result(assertion_diagnosis)
+      implicit none
+      logical, intent(in) :: success
+      type(string_t), intent(in) :: diagnostics_string
       type(assertion_diagnosis_t) assertion_diagnosis
     end function
 
   end interface
 
   interface assert
 
-    pure module subroutine julienne_assert(assertion_diagnosis)
+    pure module subroutine julienne_assert(test_diagnosis)
+      !! If the actual argument is an instance of a child type (e.g., assertion_diagnosis_t),
+      !! the dummy argument will be the child's test_diagnosis_t parent component.
       implicit none
-      type(assertion_diagnosis_t), intent(in) :: assertion_diagnosis
+      type(test_diagnosis_t), intent(in) :: test_diagnosis
     end subroutine
 
   end interface

src/julienne/julienne_test_diagnosis_m.F90

@@ -12,6 +12,8 @@ module julienne_m
   use julienne_test_description_m, only : test_description_t, diagnosis_function_i
   use julienne_test_diagnosis_m, only : &
      test_diagnosis_t &
+    ,assertion_diagnosis_t &
+    ,assert &
     ,operator(.all.) &
     ,operator(.and.) &
     ,operator(.approximates.) &

src/julienne_m.f90

@@ -0,0 +1,89 @@
+! Copyright (c) 2024, The Regents of the University of California and Sourcery Institute
+! Terms of use are as specified in LICENSE.txt
+
+#include "language-support.F90"
+
+module assert_test_m
+  !! Test Julienne's assert generic interface
+
+  use julienne_m, only : & 
+     assert &
+    ,test_diagnosis_t &
+    ,test_t &
+    ,test_description_t &
+    ,test_description_substring &
+    ,test_result_t &
+    ,operator(.approximates.) &
+    ,operator(.within.)
+  implicit none
+
+  private
+  public :: assert_test_t
+
+  type, extends(test_t) :: assert_test_t
+  contains
+    procedure, nopass :: subject
+    procedure, nopass :: results
+  end type
+
+contains
+
+  pure function subject() result(specimen)
+    character(len=:), allocatable :: specimen
+    specimen = "The assert generic interface" 
+  end function
+
+#if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY
+
+  function results() result(test_results)
+    type(test_result_t), allocatable :: test_results(:)
+
+    associate(descriptions => [ &
+      test_description_t("invocation with an test_diagnosis_t expression", check_test_diagnosis_expression) &
+    ])
+      associate(substring_in_subject => index(subject(), test_description_substring) /= 0)
+        associate(substring_in_assertion_diagnosis => descriptions%contains_text(test_description_substring))
+          associate(matching_descriptions => pack(descriptions, substring_in_subject .or. substring_in_assertion_diagnosis))
+            test_results = matching_descriptions%run()
+          end associate
+        end associate
+      end associate
+    end associate
+
+  end function
+
+#else
+
+  function results() result(test_results)
+    use julienne_m, only : diagnosis_function_i
+    !! Work around missing Fortran 2008 feature: associating a procedure actual argument with a procedure pointer dummy argument
+    type(test_result_t), allocatable :: test_results(:)
+    type(test_description_t), allocatable :: descriptions(:)
+    procedure(diagnosis_function_i), pointer :: &
+       check_test_diagnosis_expression_ptr => check_test_diagnosis_expression
+
+    descriptions = [ &
+      test_description_t("invocation with an test_diagnosis_t expression", check_test_diagnosis_expression_ptr) &
+    ]
+
+    block
+      logical substring_in_subject
+      logical, allocatable :: substring_in_assertion_diagnosis(:)
+      type(test_description_t), allocatable :: matching_descriptions(:)
+
+      substring_in_subject = index(subject(), test_description_substring) /= 0
+      substring_in_assertion_diagnosis = descriptions%contains_text(test_description_substring)
+      matching_descriptions = pack(descriptions, substring_in_subject .or. substring_in_assertion_diagnosis)
+      test_results = matching_descriptions%run()
+    end block
+  end function
+
+#endif
+
+  function check_test_diagnosis_expression() result(test_diagnosis)
+    type(test_diagnosis_t) test_diagnosis
+    call assert(1. .approximates. 2. .within. 3.)
+    test_diagnosis = test_diagnosis_t(.true., "")
+  end function
+
+end module assert_test_m

test/assert_test_m.F90

@@ -10,6 +10,7 @@ program main
   use julienne_m                     ,only : command_line_t, GitHub_CI
 
   ! Test modules
+  use assert_test_m                  ,only :                  assert_test_t
   use bin_test_m                     ,only :                     bin_test_t
   use command_line_test_m            ,only :            command_line_test_t
   use formats_test_m                 ,only :                 formats_test_t
@@ -20,6 +21,7 @@ program main
   use vector_test_description_test_m ,only : vector_test_description_test_t
   implicit none
 
+  type(assert_test_t) assert_test
   type(bin_test_t) bin_test
   type(command_line_test_t) command_line_test
   type(formats_test_t) formats_test
@@ -45,6 +47,7 @@ program main
 
   print "(a)", new_line("") // "Append '-- --help' or '-- -h' to your `fpm test` command to display usage information."
 
+  call assert_test%report(passes, tests, skips)
   call bin_test%report(passes, tests, skips)
   call formats_test%report(passes, tests, skips)
   call string_test%report(passes, tests, skips)