Add assertion utility.

Build instructions
------------------

FC=caf cmake <path-to-icar-source-dir> -DNO_ASSERTIONS=ON

Conditioning an assertion call on the value of NO_ASSERTIONS enables optimizing compilers
to eliminate the assertion via dead-code-removal optimization.

 Use case 1
 ----------
    Pass the optional "success" argument & check success without error-terminating on failure:

    use assertions_interface, only : assert,assertions
    if (assertions) call assert( 2 > 1, "always true inequality", success)
    if (error_code/=0) call my_error_handler()

 Use case 2
 ----------
    Don't pass the "success" argument and therefore error-terminate upon assertion failure:

    use assertions_interface, only : assert,assertions
    if (assertions) call assert( 2 > 1, "always true inequality")

Improve comment clarity.

Author: Damian Rouson

src/tests/CMakeLists.txt

@@ -15,7 +15,13 @@ if (HIGH_RESOLUTION_TIMER)
     )
 endif()
 
-add_subdirectory(integration)
-add_subdirectory(unit)
-add_subdirectory(installation)
-add_subdirectory(regression)
+set( directory_list
+ utilities
+ integration
+ unit
+ installation
+ regression
+)
+foreach(directory ${directory_list})
+  add_subdirectory(${directory})
+endforeach()

src/tests/utilities/CMakeLists.txt

@@ -0,0 +1,43 @@
+# Check support Fortran 2018 error termination in a pure procedure
+check_fortran_source_compiles("
+  program main
+  contains
+    pure subroutine foo()
+      error stop
+    end subroutine
+  end program
+"
+  HAVE_ERROR_STOP_IN_PURE
+  SRC_EXT ".f90"
+  )
+if(HAVE_ERROR_STOP_IN_PURE)
+  add_definitions(-DHAVE_ERROR_STOP_IN_PURE)
+endif()
+
+# Check support Fortran 2018 variable stop code
+check_fortran_source_compiles("
+  program main
+    integer i
+    i = 0
+    error stop i
+  end program
+"
+  HAVE_VARIABLE_STOP_CODE
+  SRC_EXT ".f90")
+if(HAVE_VARIABLE_STOP_CODE)
+  add_definitions(-DHAVE_VARIABLE_STOP_CODE)
+endif()
+
+#Toggle C preprocessor macro for turning assertions on or off
+if(NO_ASSERTIONS)
+  set_source_files_properties(assertions_interface.f90 PROPERTIES COMPILE_FLAGS "-cpp -DUSE_ASSERTIONS=.false.")
+else()
+  set_source_files_properties(assertions_interface.f90 PROPERTIES COMPILE_FLAGS "-cpp -DUSE_ASSERTIONS=.true.")
+endif()
+
+add_library( OpenCoarraysTestUtilities
+  object_interface.f90
+  assertions_interface.F90
+  assertions_implementation.F90
+)
+

src/tests/utilities/assertions_implementation.F90

@@ -0,0 +1,70 @@
+submodule(assertions_interface) assertions_implementation
+  !! Define the assert procedure
+
+  implicit none
+
+contains
+
+  module procedure assert
+
+    character(len=:), allocatable :: message
+
+    if (present(success)) success=assertion
+
+    if (.not.assertion) then
+
+      call set(message)
+      if (present(error_message)) error_message = message
+
+      if (.not. present(success)) then
+#ifdef HAVE_VARIABLE_STOP_CODE
+        error stop message
+#else
+        error stop "Assertion failed."
+#endif
+      end if
+    end if
+
+  contains
+
+    pure subroutine set(msg)
+
+      use object_interface, only : object
+        !! import abstract type with generic binding supporting user-defined derived type output
+
+      character(len=:), intent(out),  allocatable :: msg
+      integer, parameter :: max_image_num_digits=12, max_diagnostic_length=1024
+      integer, parameter :: msg_len = max_diagnostic_length + max_diagnostic_length
+
+      associate( base_msg_len=> len("Assertion '") +len_trim(adjustl(description)) +len("' failed on image ") +max_image_num_digits)
+        allocate( character(len=msg_len) :: msg )
+        write(msg,*) "Assertion '",trim(adjustl(description)),"' failed on image ",this_image()
+      end associate
+
+      if (present(diagnostic_data)) then
+        block
+          !! append diagnostic string
+          character(len=max_diagnostic_length) diagnostic_string
+
+          select type(diagnostic_data)
+            type is(character(len=*))
+              diagnostic_string = diagnostic_data
+            type is(real)
+              write(diagnostic_string,*) diagnostic_data
+            type is(integer)
+              write(diagnostic_string,*) diagnostic_data
+            class is(object)
+              write(diagnostic_string,*) diagnostic_data
+            class default
+              diagnostic_string = "of unrecognized type"
+          end select
+
+          msg = trim(adjustl(msg)) // " with diagnostic data " // trim(adjustl(diagnostic_string))
+        end block
+      end if
+
+    end subroutine
+
+  end procedure
+
+end submodule

src/tests/utilities/assertions_interface.F90

@@ -0,0 +1,64 @@
+#ifndef USE_ASSERTIONS
+# define USE_ASSERTIONS .false.
+#endif
+module assertions_interface
+  !! author: Damian Rouson
+  !!
+  !! Utility for runtime checking of logical assertions.
+  !!
+  !! Instructions
+  !! ------------
+  !! Compile with -DUSE_ASSERTIONS=.false. to define the logical parameter named "assertions" and to thereby
+  !! facilitate the elimination of assertions during the dead-code removal phase of optimizing compilers:
+  !!
+  !!    gfortran -cpp -DUSE_ASSERTIONS=.false. -c assertions_interface.f90
+  !!
+  !! or set the corresponding NO_ASSERTIONS variable defined in this directory's CMakeLists.txt:
+  !!
+  !!    FC=caf cmake <opencoarrays-source-path> -DNO_ASSERTIONS=ON
+  !!
+  !! Conditioning assertion calls on the "assertions" compile-time constant enables optimizing compilers
+  !! to eliminate assertion calls via dead-code-removal optimiztion.
+  !!
+  !! Use case 1
+  !! ----------
+  !!    Pass the optional success argument & check for false return value as an indication of assertion failure:
+  !!
+  !!    use assertions_interface, only : assert,assertions
+  !!    if (assertions) call assert( 2 > 1, "always true inequality", success)
+  !!    if (error_code/=0) call my_error_handler()
+  !!
+  !! Use case 2
+  !! ----------
+  !!    Error-terminate if the assertion fails:
+  !!
+  !!    use assertions_interface, only : assert,assertions
+  !!    if (assertions) call assert( 2 > 1, "always true inequality")
+  !!
+  implicit none
+  private
+  public :: assert
+  public :: assertions
+
+  logical, parameter :: assertions=USE_ASSERTIONS
+
+  interface
+#ifdef HAVE_ERROR_STOP_IN_PURE
+    pure &
+#endif
+    module subroutine assert(assertion,description,diagnostic_data,success,error_message)
+      !! On false assertion, error-terminate or, if present(success), copy assertion into success
+      implicit none
+      logical, intent(in) :: assertion
+        !! Most assertions will be expressions, e.g., call assert( i>0, "positive i")
+      character(len=*), intent(in) :: description
+        !! Brief statement of what is being asserted
+      class(*), intent(in), optional :: diagnostic_data
+        !! Optional data to printed or added to error_message assertion evaluates to .false.
+      logical, intent(out), optional :: success
+        !! Optional copy of the assertion dummy argument
+      character(len=:), intent(out), optional, allocatable :: error_message
+        !! Optional informational message allocated only if assertion==.false. .and. present(success)
+    end subroutine
+  end interface
+end module

src/tests/utilities/object_interface.f90

@@ -0,0 +1,24 @@
+module object_interface
+  !! Object pattern abstract type to provide a universal interface to a userd-defined derived type ouptput
+  !! capability specified in a generic binding
+  implicit none
+
+  type, abstract :: object
+  contains
+    procedure(write_formatted_interface), deferred :: write_formatted
+    generic :: write(formatted) => write_formatted
+  end type
+
+  abstract interface
+    subroutine write_formatted_interface(this,unit,iotype,vlist,iostat,iomsg)
+      import object
+      class(object), intent(in) :: this
+      integer, intent(in) :: unit
+      character (len=*), intent(in) :: iotype
+      integer, intent(in) :: vlist(:)
+      integer, intent(out) :: iostat
+      character (len=*), intent(inout) :: iomsg
+    end subroutine
+  end interface
+
+end module