Merge pull request #28 from BerkeleyLab/diagnostic-output

Feature: produce diagnostic output for test failures

.github/workflows/CI.yml

@@ -23,11 +23,6 @@ jobs:
         sudo apt update
         sudo apt install -y build-essential gfortran-14 g++-14
 
-    - name: Install Dependencies on macOS
-      if: contains(matrix.os, 'macos')
-      run: |
-        brew install gfortran
-
     - name: Build and Run unit tests
       run: |
         fpm test --compiler gfortran-14

doc/uml/class-diagram.md

@@ -0,0 +1,39 @@
+Julienne Unit Testing Classes
+-----------------------------
+```mermaid
+classDiagram
+
+test_t --> test_result_t : produces
+test_description_t --> test_diagnosis_t : "uses to construct test_result_t"
+test_result_t --> test_diagnosis_t : "accepts as constructor argument"
+
+class test_t{
+  <<abstract>>
+    + subject() character *
+    + results() test_result_t *
+    + report(passes : integer, tests : integer)
+}
+
+class test_result_t{
+    - description_ : character
+    - diagnostics_ : character
+    - passed : logical
+    + test_result_t(description : character, passed : test_diagnosis_t) test_result_t
+    + characterize() : character
+    + description_contains(character) : logical
+    + passed() : logical
+}
+
+class test_diagnosis_t{
+    - test_passed_ : logical
+    - diagnostics_string_ : character
+    + test_diagnosis_t(test_passed : logical, diagnostics_string : character) test_diagnosis_t
+}
+
+class test_description_t{
+    - description_ : character
+    - diagnosis_function : procecure(diagnosis_function_i), pointer
+    + test_description_t(description : character, diagnosis_function : procedure(diagnosis_function_i))
+    + run() test_result_t
+    + contains_text(character) logical
+}

doc/uml/sequence-diagram.md

@@ -0,0 +1,13 @@
+Example Sequence Diagram
+------------------------
+```mermaid
+sequenceDiagram
+    main->>specimen_test_t: report(passes, tests)
+    test_t ->>command_line_t: flag_value("--contains")
+    command_line_t ->> specimen_test_t : test_description_substring
+    test_t ->> test_t : subject
+    test_t ->> test_t : results
+    test_t ->> test_description_t : construct
+    test_t ->> test_result_t : construct
+    test_t ->> test_result_t : characterize
+    test_t ->> test_result_t : passed

example/example-test-suite/main.F90

@@ -0,0 +1,51 @@
+! 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"
+
+program main
+  !! Example test main program to demonstrate the printing of diagnostic output when a test fails
+  use julienne_m, only : command_line_t
+  use specimen_test_m, only : specimen_test_t
+  implicit none
+
+  type(specimen_test_t) specimen_test
+  integer :: passes=0, tests=0
+
+  call print_usage_and_stop_if_help_requested
+  call specimen_test%report(passes, tests)
+  call report_tally_and_error_stop_if_test_fails
+
+contains
+
+  subroutine print_usage_and_stop_if_help_requested
+    type(command_line_t) command_line
+    if (command_line%argument_present([character(len=len("--help"))::"--help","-h"]))  then
+      print *
+      print '(a)', 'Usage: fpm run --example main -- [--help] | [--contains <substring>]'
+      print *
+      print '(a)', 'where square brackets ([]) denote optional arguments, a pipe (|) separates alternative arguments,'
+      print '(a)', 'angular brackets (<>) denote a user-provided value, and passing a substring limits execution to'
+      print '(a)', 'the tests with test subjects or test descriptions containing the user-specified substring.'
+      stop
+    else
+      print * 
+      print "(a)", "Append '-- --help' or '-- -h' to your `fpm test` command to display usage information."
+    end if
+  end subroutine
+
+  subroutine report_tally_and_error_stop_if_test_fails
+
+#if HAVE_MULTI_IMAGE_SUPPORT
+    if (this_image()==1) then
+#endif
+      print *
+      print '(*(a,:,g0))', "_________ In total, ",passes," of ",tests, " tests pass. _________"
+      if (passes /= tests) error stop "Some tests failed."
+#if HAVE_MULTI_IMAGE_SUPPORT
+    end if
+#endif
+
+  end subroutine
+
+end program

example/example-test-suite/specimen_m.F90

@@ -0,0 +1,19 @@
+! Copyright (c) 2024, The Regents of the University of California and Sourcery Institute
+! Terms of use are as specified in LICENSE.txt
+module specimen_m
+  !! Example test specimen corresponding to the test defined in specimen_test_m.F90
+  implicit none
+
+  type specimen_t
+  contains
+    procedure, nopass :: zero
+  end type
+
+contains
+
+  pure function zero() result(incorrect_value)
+    integer incorrect_value
+    incorrect_value = 1
+  end function
+
+end module

example/example-test-suite/specimen_test_m.F90

@@ -0,0 +1,80 @@
+! 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 specimen_test_m
+  !! Example unit test for the specimen_t test subject
+  use specimen_m, only : specimen_t
+  use julienne_m, only : &
+    string_t, &
+    test_t, &
+    test_result_t, &
+    test_description_t, &
+    test_description_substring, &
+    test_diagnosis_t
+#if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY
+  use julienne_m, only : diagnosis_function_i ! work around gfortran's missing Fortran 2008 feature
+#endif
+
+  implicit none
+
+  private
+  public :: specimen_test_t
+
+  type, extends(test_t) :: specimen_test_t
+  contains
+    procedure, nopass :: subject
+    procedure, nopass :: results
+  end type
+
+contains
+
+  pure function subject() result(specimen_description)
+    character(len=:), allocatable :: specimen_description
+    specimen_description = "A specimen_t object" 
+  end function
+
+  function results() result(test_results)
+    type(test_result_t), allocatable :: test_results(:)
+    type(test_description_t), allocatable :: test_descriptions(:)
+
+#if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY
+    test_descriptions = [ & 
+      test_description_t("the type-bound function zero() producing a result of 0", check_zero) &
+    ]   
+#else 
+    ! work around gfortran's missing Fortran 2008 feature
+    procedure(diagnosis_function_i), pointer :: check_zero_ptr
+    check_zero_ptr => check_zero
+
+    test_descriptions = [ & 
+      test_description_t("the type-bound function zero() producing a result of 0", check_zero_ptr) &
+    ]   
+#endif
+#ifndef __GFORTRAN__
+    associate(test_subset => pack(test_descriptions, test_descriptions%contains_text(test_description_substring) .or. index(subject(), test_description_substring)/=0))
+      test_results = test_subset%run()
+    end associate
+#else 
+
+    test_descriptions = pack(test_descriptions, test_descriptions%contains_text(test_description_substring) .or. index(subject(), test_description_substring)/=0)
+    test_results = test_descriptions%run()
+#endif
+
+  end function
+
+  function check_zero() result(test_diagnosis)
+    type(test_diagnosis_t) test_diagnosis
+    type(specimen_t) specimen
+    integer, parameter :: expected_value = 0
+
+    associate(actual_value => specimen%zero())
+      test_diagnosis = test_diagnosis_t( &
+         test_passed = actual_value == expected_value &
+        ,diagnostics_string = "expected value " // string_t(expected_value) //", actual value " // string_t(actual_value) &
+      )
+    end associate
+  end function
+
+end module

fpm.toml

@@ -6,7 +6,7 @@ maintainer = "rouson@lbl.gov"
 copyright = "Copyright 2024, Sourcery Institute and Berkeley Lab"
 
 [dependencies]
-assert = {git = "https://github.com/sourceryinstitute/assert", tag = "1.7.0"}
+assert = {git = "https://github.com/sourceryinstitute/assert", tag = "2.0.0"}
 
 [install]
 library = true

src/julienne/julienne_string_m.f90

@@ -68,12 +68,18 @@ elemental module function from_default_integer(i) result(string)
       type(string_t) string
     end function
 
-    elemental module function from_real(x) result(string)
+    elemental module function from_default_real(x) result(string)
       implicit none
       real, intent(in) :: x
       type(string_t) string
     end function
 
+    elemental module function from_double_precision(x) result(string)
+      implicit none
+      double precision, intent(in) :: x
+      type(string_t) string
+    end function
+
   end interface
 
   interface operator(.cat.)

src/julienne/julienne_string_s.f90

@@ -19,14 +19,19 @@
   end procedure
 
   module procedure from_default_integer
-    integer, parameter :: sign_width = 1, digits_width = range(i) + 1
-    character(len = digits_width + sign_width) characters
-    write(characters, '(i0)') i
+    character(len=11) characters
+    write(characters, '(g0)') i
     string = string_t(trim(characters))
   end procedure
 
-  module procedure from_real
-    character(len=100) characters
+  module procedure from_default_real
+    character(len=16) characters
+    write(characters, '(g0)') x
+    string = string_t(trim(characters))
+  end procedure
+
+  module procedure from_double_precision
+    character(len=24) characters
     write(characters, '(g0)') x
     string = string_t(trim(characters))
   end procedure

src/julienne/julienne_test_description_m.f90

@@ -4,24 +4,35 @@ module julienne_test_description_m
   !! Define an abstraction for describing test intentions and test functions
   use julienne_string_m, only : string_t
   use julienne_test_result_m, only : test_result_t
+  use julienne_test_diagnosis_m, only : test_diagnosis_t
   implicit none
 
   private
   public :: test_description_t
   public :: test_function_i
+  public :: diagnosis_function_i
 
   abstract interface
-    function test_function_i() result(passes)
+
+    function test_function_i() result(passed)
       implicit none
-      logical passes
+      logical passed
     end function
+
+    function diagnosis_function_i() result(test_diagnosis)
+      import test_diagnosis_t
+      implicit none
+      type(test_diagnosis_t) test_diagnosis
+    end function
+
   end interface
 
   type test_description_t
     !! Encapsulate test descriptions and test-functions
     private
-    type(string_t) description_
+    character(len=:), allocatable :: description_
     procedure(test_function_i), pointer, nopass :: test_function_ => null()
+    procedure(diagnosis_function_i), pointer, nopass :: diagnosis_function_ => null()
   contains
     procedure run
     generic :: contains_text => contains_string_t, contains_characters
@@ -32,22 +43,38 @@ function test_function_i() result(passes)
 
   interface test_description_t
 
-    module function construct_from_string_t(description, test_function) result(test_description)
+    module function construct_from_string_t_and_test_function(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)
+    module function construct_from_character_and_test_function(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
 
+    module function construct_from_string_t_and_diagnosis_function(description, diagnosis_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(diagnosis_function_i), intent(in), pointer :: diagnosis_function
+      type(test_description_t) test_description
+    end function
+
+    module function construct_from_character_and_diagnosis_function(description, diagnosis_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(diagnosis_function_i), intent(in), pointer :: diagnosis_function
+      type(test_description_t) test_description
+    end function
+
   end interface
 
   interface