Feature: support comparison expressions that evaluate to test diagnoses

include/language-support.F90

@@ -1,23 +1,38 @@
 ! Copyright (c) 2024-2025, The Regents of the University of California
 ! Terms of use are as specified in LICENSE.txt
 
+#ifndef _JULIENNE_LANGUAGE_SUPPORT_H
+#define _JULIENNE_LANGUAGE_SUPPORT_H
+
+! If not already determined, make a compiler-dependent determination of whether Julienne may pass
+! procedure actual arguments to procedure pointer dummy arguments, a feature introduced in
+! Fortran 2008 and described in Fortran 2023 clause 15.5.2.10 paragraph 5.
 #ifndef HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY
-  ! Define whether the compiler supports associating a procedure pointer dummy argument with an
-  ! actual argument that is a valid target for the pointer dummy in a procedure assignment, a
-  ! feature introduced in Fortran 2008 and described in Fortran 2023 clause 15.5.2.10 paragraph 5.
-#if defined(_CRAYFTN) || defined(__INTEL_COMPILER) || defined(NAGFOR) || defined(__flang__)
-#define HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY 1
-#else
-#define HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY 0
-#endif
+#  if defined(__GFORTRAN__)
+#    define HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY 0
+#  else
+#    define HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY 1
+#  endif
 #endif
 
+! If not already determined, make a compiler-dependent determination of whether Julienne may use
+! multi-image features such as `this_image()` and `sync all`.
 #ifndef HAVE_MULTI_IMAGE_SUPPORT
-  ! Define whether the compiler supports the statements and intrinsic procedures that support
-  ! multi-image execution, e.g., this_image(), sync all, etc.
-#if defined(_CRAYFTN) || defined(__INTEL_COMPILER) || defined(NAGFOR) || defined(__GFORTRAN__)
-#define HAVE_MULTI_IMAGE_SUPPORT 1
-#else
-#define HAVE_MULTI_IMAGE_SUPPORT 0
+#  if defined(__flang__)
+#    define HAVE_MULTI_IMAGE_SUPPORT 0
+#  else
+#    define HAVE_MULTI_IMAGE_SUPPORT 1
+#  endif
 #endif
+
+! If not already determined, make a compiler-dependent determination of whether Julienne may use
+! kind type parameters for derived types.
+#ifndef HAVE_DERIVED_TYPE_KIND_PARAMETERS
+#  if defined(__GFORTRAN__)
+#    define HAVE_DERIVED_TYPE_KIND_PARAMETERS 0
+#  else
+#    define HAVE_DERIVED_TYPE_KIND_PARAMETERS 1
+#  endif
+#endif
+
 #endif

src/julienne/julienne_test_diagnosis_m.F90

@@ -1,12 +1,24 @@
 ! Copyright (c) 2024-2025, The Regents of the University of California and Sourcery Institute
 ! Terms of use are as specified in LICENSE.txt
+
+#include "language-support.F90"
+
 module julienne_test_diagnosis_m
   !! Define an abstraction for describing test outcomes and diagnostic information
   use julienne_string_m, only : string_t
   implicit none
 
   private
   public :: test_diagnosis_t
+  public :: operator(.all.)
+  public :: operator(.and.)
+  public :: operator(.approximates.)
+  public :: operator(.within.)
+  public :: operator(.equalsExpected.)
+  public :: operator(.lessThan.)
+  public :: operator(.lessThanOrEqualTo.)
+  public :: operator(.greaterThan.)
+  public :: operator(.greaterThanOrEqualTo.)
 
   type test_diagnosis_t
     !! Encapsulate test outcome and diagnostic information
@@ -18,6 +30,159 @@ module julienne_test_diagnosis_m
     procedure diagnostics_string
   end type
 
+  integer, parameter :: default_real = kind(1.), double_precision = kind(1D0)
+
+#if HAVE_DERIVED_TYPE_KIND_PARAMETERS
+  type operands_t(k)
+    integer, kind :: k = default_real
+    real(k) actual, expected 
+  end type
+#else
+  type operands_t
+    real actual, expected 
+  end type
+
+  type double_precision_operands_t
+    double precision actual, expected 
+  end type
+#endif
+
+  interface operator(.all.)
+
+    pure module function aggregate_diagnosis(diagnoses) result(diagnosis)
+      implicit none
+      type(test_diagnosis_t), intent(in) :: diagnoses(..)
+      type(test_diagnosis_t) diagnosis
+    end function
+
+  end interface
+
+  interface operator(.and.)
+
+    elemental module function and(lhs, rhs) result(diagnosis)
+      implicit none
+      type(test_diagnosis_t), intent(in) :: lhs, rhs
+      type(test_diagnosis_t) diagnosis
+    end function
+
+  end interface
+
+  interface operator(.approximates.)
+
+    elemental module function approximates_real(actual, expected) result(operands)
+      implicit none
+      real, intent(in) :: actual, expected
+      type(operands_t) operands
+    end function
+
+    elemental module function approximates_double_precision(actual, expected) result(operands)
+      implicit none
+      double precision, intent(in) :: actual, expected
+#if HAVE_DERIVED_TYPE_KIND_PARAMETERS
+      type(operands_t(double_precision)) operands
+#else
+      type(double_precision_operands_t) operands
+#endif
+    end function
+
+  end interface
+
+  interface operator(.equalsExpected.)
+
+    elemental module function equals_expected_integer(actual, expected) result(test_diagnosis)
+      implicit none
+      integer, intent(in) :: actual, expected
+      type(test_diagnosis_t) test_diagnosis
+    end function
+
+  end interface
+
+  interface operator(.lessThan.)
+
+    elemental module function less_than_real(actual, expected_ceiling) result(test_diagnosis)
+      implicit none
+      real, intent(in) :: actual, expected_ceiling
+      type(test_diagnosis_t) test_diagnosis
+    end function
+
+    elemental module function less_than_double(actual, expected_ceiling) result(test_diagnosis)
+      implicit none
+      double precision, intent(in) :: actual, expected_ceiling
+      type(test_diagnosis_t) test_diagnosis
+    end function
+
+    elemental module function less_than_integer(actual, expected_ceiling) result(test_diagnosis)
+      implicit none
+      integer, intent(in) :: actual, expected_ceiling
+      type(test_diagnosis_t) test_diagnosis
+    end function
+
+  end interface
+
+  interface operator(.lessThanOrEqualTo.)
+
+    elemental module function less_than_or_equal_to_integer(actual, expected_max) result(test_diagnosis)
+      implicit none
+      integer, intent(in) :: actual, expected_max
+      type(test_diagnosis_t) test_diagnosis
+    end function
+
+  end interface
+
+  interface operator(.greaterThanOrEqualTo.)
+
+    elemental module function greater_than_or_equal_to_integer(actual, expected_min) result(test_diagnosis)
+      implicit none
+      integer, intent(in) :: actual, expected_min
+      type(test_diagnosis_t) test_diagnosis
+    end function
+
+  end interface
+
+  interface operator(.greaterThan.)
+
+    elemental module function greater_than_real(actual, expected_floor) result(test_diagnosis)
+      implicit none
+      real, intent(in) :: actual, expected_floor
+      type(test_diagnosis_t) test_diagnosis
+    end function
+
+    elemental module function greater_than_double(actual, expected_floor) result(test_diagnosis)
+      implicit none
+      double precision, intent(in) :: actual, expected_floor
+      type(test_diagnosis_t) test_diagnosis
+    end function
+
+    elemental module function greater_than_integer(actual, expected_floor) result(test_diagnosis)
+      implicit none
+      integer, intent(in) :: actual, expected_floor
+      type(test_diagnosis_t) test_diagnosis
+    end function
+
+  end interface
+
+  interface operator(.within.)
+
+    elemental module function within_real(operands, tolerance) result(test_diagnosis)
+      implicit none
+      type(operands_t), intent(in) :: operands
+      real, intent(in) :: tolerance
+      type(test_diagnosis_t) test_diagnosis
+    end function
+
+    elemental module function within_double_precision(operands, tolerance) result(test_diagnosis)
+      implicit none
+#if HAVE_DERIVED_TYPE_KIND_PARAMETERS
+      type(operands_t(double_precision)), intent(in) :: operands
+#else
+      type(double_precision_operands_t), intent(in) :: operands
+#endif
+      double precision, intent(in) :: tolerance
+      type(test_diagnosis_t) test_diagnosis
+    end function
+
+  end interface
+
   interface test_diagnosis_t
 
     elemental module function construct_from_string_t(test_passed, diagnostics_string) result(test_diagnosis)