From 16a9adaed7824547fcd2a4cdfa0376e8f2c6c40b Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Tue, 31 Aug 2021 11:24:05 -0700 Subject: [PATCH 1/3] Delete assertions_implementation.F90 This has been moved to its own project at https://github.com/sourceryinstitute/assert. --- src/assertions_implementation.F90 | 62 ------------------------------- 1 file changed, 62 deletions(-) delete mode 100644 src/assertions_implementation.F90 diff --git a/src/assertions_implementation.F90 b/src/assertions_implementation.F90 deleted file mode 100644 index 2da40813..00000000 --- a/src/assertions_implementation.F90 +++ /dev/null @@ -1,62 +0,0 @@ -! -! (c) 2019-2020 Guide Star Engineering, LLC -! This Software was developed for the US Nuclear Regulatory Commission (US NRC) under contract -! "Multi-Dimensional Physics Implementation into Fuel Analysis under Steady-state and Transients (FAST)", -! contract # NRC-HQ-60-17-C-0007 -! -submodule(assertions_interface) assertions_implementation - implicit none - -contains - - module procedure assert - use iso_fortran_env, only : error_unit - use string_functions_interface, only : string - use object_interface, only : object_t - - character(len=:), allocatable :: header, trailer - integer, parameter :: max_this_image_digits=9 - - if (assertions) then - - if (.not. assertion) then - - associate(assertion_failed_on => 'Assertion "' // description // '" failed on image') - header = repeat(" ", ncopies = len(assertion_failed_on) + max_this_image_digits) - write(header, *) assertion_failed_on, this_image() - end associate - - if (.not. present(diagnostic_data)) then - - trailer = "" - - else - - block - character(len=*), parameter :: prefix = "with diagnostic data" - integer, parameter :: max_data_length = 1024 - - select type(diagnostic_data) - type is(character(len=*)) - trailer = prefix // diagnostic_data - type is(integer) - trailer = prefix // string(diagnostic_data) - class is(object_t) - trailer = repeat(" ", ncopies = max_data_length) - write(trailer,*) diagnostic_data - class default - trailer = prefix // 'of unsupported type' - end select - end block - - end if - - error stop header // trim(trailer) - - end if - - end if - - end procedure - -end submodule From 8d29eb360299405b75474c4474717a354ad8fa42 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Tue, 31 Aug 2021 11:24:24 -0700 Subject: [PATCH 2/3] Delete assertions_interface.f90 This has been moved to its own project at https://github.com/sourceryinstitute/assert. --- src/assertions_interface.F90 | 47 ------------------------------------ 1 file changed, 47 deletions(-) delete mode 100644 src/assertions_interface.F90 diff --git a/src/assertions_interface.F90 b/src/assertions_interface.F90 deleted file mode 100644 index fafc541a..00000000 --- a/src/assertions_interface.F90 +++ /dev/null @@ -1,47 +0,0 @@ -! -! (c) 2019-2020 Guide Star Engineering, LLC -! This Software was developed for the US Nuclear Regulatory Commission (US NRC) under contract -! "Multi-Dimensional Physics Implementation into Fuel Analysis under Steady-state and Transients (FAST)", -! contract # NRC-HQ-60-17-C-0007 -! -#ifndef USE_ASSERTIONS -# define USE_ASSERTIONS .true. -#endif -module assertions_interface - !! summary: Utility for runtime checking of logical assertions. - !! usage: error-terminate if the assertion fails: - !! - !! use assertions_interface, only : assert - !! call assert( 2 > 1, "2 > 1") - !! - !! Turn off assertions in production code by setting USE_ASSERTIONS to .false. via the preprocessor: - !! - !! caf -cpp -DUSE_ASSERTIONS=.false. -c assertions_interface.f90 - !! - !! Doing so may eliminate any associated runtime overhead by enabling optimizing compilers to ignore - !! the assertion procedure body during a dead-code-removal phase of optimization. - implicit none - private - public :: assert, assertions, max_errmsg_len - - logical, parameter :: assertions=USE_ASSERTIONS - integer, parameter :: max_errmsg_len = len( & - "warning (183): FASTMEM allocation is requested but the libmemkind library is not linked in, so using the default allocator.") - !! longest Intel compiler error message (see https://intel.ly/35x84yr). - - interface - - elemental module subroutine assert(assertion, description, diagnostic_data) - !! If assertion is .false., error-terminate with optional, variable stop code containing diagnostic_data - 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 error stop code, which may be of intrinsic type or object class - end subroutine - - end interface - -end module From 62c2244a6cc3f94287d41ddbd2b9028f87183106 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Tue, 31 Aug 2021 11:34:45 -0700 Subject: [PATCH 3/3] fix: remove local assert; use new Assert library add dependency in fpm.toml --- fpm.toml | 3 +++ src/array_functions_implementation.f90 | 6 +++--- src/data-partition-implementation.F90 | 6 +++--- src/emulated_intrinsics_implementation.F90 | 2 +- 4 files changed, 10 insertions(+), 7 deletions(-) diff --git a/fpm.toml b/fpm.toml index 9546f8da..48a2240c 100644 --- a/fpm.toml +++ b/fpm.toml @@ -5,6 +5,9 @@ author = ["Damian Rouson"] maintainer = "damian@sourceryinstitute.org" copyright = "2020 Sourcery Institute" +[dependencies] +assert = {git = "https://github.com/sourceryinstitute/assert", tag = "1.0.0"} + [dev-dependencies] vegetables = {git = "https://gitlab.com/everythingfunctional/vegetables", tag = "v6.0.1"} diff --git a/src/array_functions_implementation.f90 b/src/array_functions_implementation.f90 index 2c64f592..13ce100e 100644 --- a/src/array_functions_implementation.f90 +++ b/src/array_functions_implementation.f90 @@ -5,7 +5,7 @@ ! contract # NRC-HQ-60-17-C-0007 ! submodule(array_functions_interface) array_functions_implementation - use assertions_interface, only : assert, assertions + use assert_m, only : assert implicit none contains @@ -13,7 +13,7 @@ integer i, j, k associate( n => shape(vector_field) ) - if (assertions) call assert(size(n)==4, "3D vector field input") + call assert(size(n)==4, "3D vector field input") allocate( array_of_3D_column_vectors( n(4), product(n(1:3)) ) ) do concurrent( i=1:n(1), j=1:n(2), k=1:n(3) ) associate( id => (k-1)*PRODUCT(n(1:2)) + (j-1)*n(1) + i ) @@ -34,7 +34,7 @@ associate(cols=>size(a,2)+size(b,2)) associate(a_unrolled=>reshape(a,[size(a)])) associate(b_unrolled=>reshape(b,[size(b)])) - if (assertions) call assert( rows==size(b,1), "array_functions: compatible shapes") + call assert( rows==size(b,1), "array_functions: compatible shapes") concatenated = reshape( [a_unrolled, b_unrolled ],[rows, cols] ) end associate; end associate; end associate; end associate end procedure diff --git a/src/data-partition-implementation.F90 b/src/data-partition-implementation.F90 index d519da4d..41cadc71 100644 --- a/src/data-partition-implementation.F90 +++ b/src/data-partition-implementation.F90 @@ -1,5 +1,5 @@ submodule(data_partition_interface) data_partition_implementation - use assertions_interface, only : assert, assertions + use assert_m, only : assert implicit none logical, parameter :: verbose=.false. @@ -45,12 +45,12 @@ pure function overflow(im, excess) result(extra_datum) #endif module procedure first - if (assertions) call assert( allocated(first_datum), "allocated(first_datum)") + call assert( allocated(first_datum), "allocated(first_datum)") first_index= first_datum( image_number ) end procedure module procedure last - if (assertions) call assert( allocated(last_datum), "allocated(last_datum)") + call assert( allocated(last_datum), "allocated(last_datum)") last_index = last_datum( image_number ) end procedure diff --git a/src/emulated_intrinsics_implementation.F90 b/src/emulated_intrinsics_implementation.F90 index 0a5a4a4d..cfed516a 100644 --- a/src/emulated_intrinsics_implementation.F90 +++ b/src/emulated_intrinsics_implementation.F90 @@ -5,7 +5,7 @@ ! contract # NRC-HQ-60-17-C-0007 ! submodule(emulated_intrinsics_interface) emulated_intrinsics_implementation - use assertions_interface, only : assert + use assert_m, only : assert implicit none contains