Merge pull request #1183 from billsacks/assert_file_line

Allow passing file and line to shr_assert
Up until now, many calls to shr_assert (often done through the
SHR_ASSERT macro) gave file and line information via a call to
shr_log_errMsg. However, the shr_log_errMsg function is terrible for
performance for some reason. This PR adds optional arguments to the
shr_assert interface (and related macros) so that you can pass the file
and line directly into that function. Then the cost of building an error
message is only borne if you actually abort.

So, for example, you can replace

SHR_ASSERT(condition, shr_log_errMsg(__FILE__, __LINE__))
with

SHR_ASSERT_FL(condition, __FILE__, __LINE__)
(where 'FL' stands for FileLine).

I have done this replacement for all relevant cime Fortran code.

Test suite: cime Fortran unit tests and ./create_test cime_developer on
yellowstone; also ran debug tests on yellowstone-intel,
yellowstone-pgi, yellowstone-gnu and hobart-nag in a version rebased
onto cime5.2.0-alpha.9
Test baseline: N/A
Test namelist changes: none
Test status: bit for bit

User interface changes?: none

Code review: @jedwards4b

driver_cpl/driver/map_glc2lnd_mod.F90

@@ -248,7 +248,7 @@ subroutine get_glc_elevation_classes(glc_topo, glc_elevclass)
     !-----------------------------------------------------------------------
 
     npts = size(glc_elevclass)
-    SHR_ASSERT((size(glc_topo) == npts), errMsg(__FILE__, __LINE__))
+    SHR_ASSERT_FL((size(glc_topo) == npts), __FILE__, __LINE__)
 
     do glc_pt = 1, npts
        call glc_get_elevation_class(glc_topo(glc_pt), glc_elevclass(glc_pt), err_code)
@@ -291,8 +291,8 @@ subroutine get_frac_this_ec(glc_frac, glc_elevclass, this_elevclass, glc_frac_th
     !-----------------------------------------------------------------------
 
     npts = size(glc_frac_this_ec)
-    SHR_ASSERT((size(glc_frac) == npts), errMsg(__FILE__, __LINE__))
-    SHR_ASSERT((size(glc_elevclass) == npts), errMsg(__FILE__, __LINE__))
+    SHR_ASSERT_FL((size(glc_frac) == npts), __FILE__, __LINE__)
+    SHR_ASSERT_FL((size(glc_elevclass) == npts), __FILE__, __LINE__)
 
     if (this_elevclass == 0) then
        glc_frac_this_ec(:) = 1._r8 - glc_frac(:)
@@ -340,7 +340,7 @@ subroutine set_topo_in_virtual_columns(elev_class, glc_frac_this_ec_l, &
 
     ! Extract fields from attribute vectors
     lsize = mct_aVect_lsize(glc_frac_this_ec_l)
-    SHR_ASSERT(mct_aVect_lsize(glc_topo_this_ec_l) == lsize, errMsg(__FILE__, __LINE__))
+    SHR_ASSERT_FL(mct_aVect_lsize(glc_topo_this_ec_l) == lsize, __FILE__, __LINE__)
     allocate(frac_l(lsize))
     allocate(topo_l(lsize))
     call mct_aVect_exportRattr(glc_frac_this_ec_l, frac_field, frac_l)
@@ -388,7 +388,7 @@ subroutine make_aVect_frac_times_icemask(frac_av, mask_av, frac_field, icemask_f
     !-----------------------------------------------------------------------
 
     lsize = mct_aVect_lsize(frac_av)
-    SHR_ASSERT(mct_aVect_lsize(mask_av) == lsize, errMsg(__FILE__, __LINE__))
+    SHR_ASSERT_FL(mct_aVect_lsize(mask_av) == lsize, __FILE__, __LINE__)
 
     call mct_aVect_init(frac_times_icemask_av, rList = frac_times_icemask_field, lsize = lsize)
     call mct_aVect_copy(aVin = frac_av, aVout = frac_times_icemask_av, &

driver_cpl/driver/map_lnd2glc_mod.F90

@@ -224,8 +224,8 @@ subroutine get_glc_elevation_classes(glc_ice_covered, glc_topo, glc_elevclass)
     !-----------------------------------------------------------------------
 
     npts = size(glc_elevclass)
-    SHR_ASSERT((size(glc_ice_covered) == npts), errMsg(__FILE__, __LINE__))
-    SHR_ASSERT((size(glc_topo) == npts), errMsg(__FILE__, __LINE__))
+    SHR_ASSERT_FL((size(glc_ice_covered) == npts), __FILE__, __LINE__)
+    SHR_ASSERT_FL((size(glc_topo) == npts), __FILE__, __LINE__)
 
     do glc_pt = 1, npts
        if (abs(glc_ice_covered(glc_pt) - 1._r8) < ice_covered_tol) then
@@ -287,7 +287,7 @@ subroutine map_bare_land(l2x_l, landfrac_l, fieldname, mapper, data_g_bare_land)
     character(len=*), parameter :: subname = 'map_bare_land'
     !-----------------------------------------------------------------------
 
-    SHR_ASSERT(associated(data_g_bare_land), errMsg(__FILE__, __LINE__))
+    SHR_ASSERT_FL(associated(data_g_bare_land), __FILE__, __LINE__)
 
     lsize_g = size(data_g_bare_land)
     elevclass_as_string = glc_elevclass_as_string(0)
@@ -379,7 +379,7 @@ subroutine map_one_elevation_class(l2x_l, landfrac_l, fieldname, elevclass, &
     !-----------------------------------------------------------------------
 
     lsize_g = size(data_g_thisEC)
-    SHR_ASSERT((size(topo_g) == lsize_g), errMsg(__FILE__, __LINE__))
+    SHR_ASSERT_FL((size(topo_g) == lsize_g), __FILE__, __LINE__)
 
     ! ------------------------------------------------------------------------
     ! Create temporary attribute vectors

driver_cpl/driver/map_lnd2rof_irrig_mod.F90

@@ -258,8 +258,8 @@ subroutine map_rof2lnd_volr(volr_r, mapper_Fr2l, volr_l)
     character(len=*), parameter :: volr_field = 'volr'
     !---------------------------------------------------------------
 
-    SHR_ASSERT(associated(volr_r), errMsg(sourcefile, __LINE__))
-    SHR_ASSERT(associated(volr_l), errMsg(sourcefile, __LINE__))
+    SHR_ASSERT_FL(associated(volr_r), sourcefile, __LINE__)
+    SHR_ASSERT_FL(associated(volr_l), sourcefile, __LINE__)
 
     lsize_r = size(volr_r)
     lsize_l = size(volr_l)

driver_cpl/driver/vertical_gradient_calculator_2nd_order.F90

@@ -100,8 +100,8 @@ function constructor(field, topo, elevclass_bounds) result(this)
 
     this%num_points = size(field, 1)
     this%nelev = size(field, 2)
-    SHR_ASSERT_ALL((ubound(topo) == (/this%num_points, this%nelev/)), errMsg(__FILE__, __LINE__))
-    SHR_ASSERT_ALL((ubound(elevclass_bounds) == (/this%nelev/)), errMsg(__FILE__, __LINE__))
+    SHR_ASSERT_ALL_FL((ubound(topo) == (/this%num_points, this%nelev/)), __FILE__, __LINE__)
+    SHR_ASSERT_ALL_FL((ubound(elevclass_bounds) == (/this%nelev/)), __FILE__, __LINE__)
 
     allocate(this%elevclass_bounds(0:this%nelev))
     this%elevclass_bounds(:) = elevclass_bounds(:)
@@ -231,8 +231,8 @@ subroutine get_gradients_one_class(this, elevation_class, gradients)
 
     ! Assert pre-conditions
 
-    SHR_ASSERT(this%calculated, errMsg(__FILE__, __LINE__))
-    SHR_ASSERT((size(gradients) == this%num_points), errMsg(__FILE__, __LINE__))
+    SHR_ASSERT_FL(this%calculated, __FILE__, __LINE__)
+    SHR_ASSERT_FL((size(gradients) == this%num_points), __FILE__, __LINE__)
 
     if (elevation_class < 1 .or. elevation_class > this%nelev) then
        write(logunit,*) subname, ': ERROR: elevation class out of bounds: ', &
@@ -266,9 +266,9 @@ subroutine get_gradients_one_point(this, point, gradients)
     character(len=*), parameter :: subname = 'get_gradients_one_point'
     !-----------------------------------------------------------------------
 
-    SHR_ASSERT(this%calculated, errMsg(__FILE__, __LINE__))
-    SHR_ASSERT(point <= this%num_points, errMsg(__FILE__, __LINE__))
-    SHR_ASSERT((size(gradients) == this%nelev), errMsg(__FILE__, __LINE__))
+    SHR_ASSERT_FL(this%calculated, __FILE__, __LINE__)
+    SHR_ASSERT_FL(point <= this%num_points, __FILE__, __LINE__)
+    SHR_ASSERT_FL((size(gradients) == this%nelev), __FILE__, __LINE__)
 
     gradients(:) = this%vertical_gradient(point, :)
 

driver_cpl/driver/vertical_gradient_calculator_factory.F90

@@ -55,7 +55,7 @@ function create_vertical_gradient_calculator_2nd_order( &
     !-----------------------------------------------------------------------
 
     nelev = size(elevclass_names)
-    SHR_ASSERT_ALL((ubound(elevclass_bounds) == (/nelev/)), errMsg(__FILE__, __LINE__))
+    SHR_ASSERT_ALL_FL((ubound(elevclass_bounds) == (/nelev/)), __FILE__, __LINE__)
 
     call extract_data_from_attr_vect(attr_vect, fieldname, toponame, elevclass_names, &
          field, topo)

driver_cpl/shr/glc_elevclass_mod.F90

@@ -126,7 +126,7 @@ subroutine glc_elevclass_init_override(my_glc_nec, my_topomax)
     character(len=*), parameter :: subname = 'glc_elevclass_init_override'
     !-----------------------------------------------------------------------
 
-    SHR_ASSERT_ALL((ubound(my_topomax) == (/my_glc_nec/)), errMsg(__FILE__, __LINE__))
+    SHR_ASSERT_ALL_FL((ubound(my_topomax) == (/my_glc_nec/)), __FILE__, __LINE__)
 
     glc_nec = my_glc_nec
     allocate(topomax(0:glc_nec))

driver_cpl/unit_test/map_lnd2rof_irrig_test/test_map_lnd2rof_irrig.pf

@@ -73,10 +73,10 @@ contains
 
     nlnd = map_l2r%get_n_source_points()
     nrof = map_l2r%get_n_dest_points()
-    call shr_assert(map_r2l%get_n_dest_points() == nlnd, errMsg(sourcefile, __LINE__))
-    call shr_assert(map_r2l%get_n_source_points() == nrof, errMsg(sourcefile, __LINE__))
-    call shr_assert(size(irrig_l) == nlnd, errMsg(sourcefile, __LINE__))
-    call shr_assert(size(volr_r) == nrof, errMsg(sourcefile, __LINE__))
+    call shr_assert(map_r2l%get_n_dest_points() == nlnd, file=sourcefile, line=__LINE__)
+    call shr_assert(map_r2l%get_n_source_points() == nrof, file=sourcefile, line=__LINE__)
+    call shr_assert(size(irrig_l) == nlnd, file=sourcefile, line=__LINE__)
+    call shr_assert(size(volr_r) == nrof, file=sourcefile, line=__LINE__)
 
     call create_aVect_with_data_rows_are_points(this%l2r_l, &
          attr_tags = [irrig_flux_field], &

driver_cpl/unit_test/utils/simple_map_mod.F90

@@ -66,8 +66,8 @@ function constructor(source_indices, dest_indices, overlap_weights) result(this)
     !-----------------------------------------------------------------------
 
     n_overlaps = size(overlap_weights)
-    call shr_assert(size(source_indices) == n_overlaps, errMsg(__FILE__, __LINE__))
-    call shr_assert(size(dest_indices) == n_overlaps, errMsg(__FILE__, __LINE__))
+    call shr_assert(size(source_indices) == n_overlaps, file=__FILE__, line=__LINE__)
+    call shr_assert(size(dest_indices) == n_overlaps, file=__FILE__, line=__LINE__)
 
     this%n_overlaps = n_overlaps
     this%source_indices = source_indices

share/csm_share/include/shr_assert.h

@@ -1,10 +1,22 @@
 #ifdef NDEBUG
 #define SHR_ASSERT(assert, msg)
+#define SHR_ASSERT_FL(assert, file, line)
+#define SHR_ASSERT_MFL(assert, msg, file, line)
 #define SHR_ASSERT_ALL(assert, msg)
+#define SHR_ASSERT_ALL_FL(assert, file, line)
+#define SHR_ASSERT_ALL_MFL(assert, msg, file, line)
 #define SHR_ASSERT_ANY(assert, msg)
+#define SHR_ASSERT_ANY_FL(assert, file, line)
+#define SHR_ASSERT_ANY_MFL(assert, msg, file, line)
 #else
-#define SHR_ASSERT(assert, msg) call shr_assert(assert, msg)
-#define SHR_ASSERT_ALL(assert, msg) call shr_assert_all(assert, msg)
-#define SHR_ASSERT_ANY(assert, msg) call shr_assert_any(assert, msg)
+#define SHR_ASSERT(assert, my_msg) call shr_assert(assert, msg=my_msg)
+#define SHR_ASSERT_FL(assert, my_file, my_line) call shr_assert(assert, file=my_file, line=my_line)
+#define SHR_ASSERT_MFL(assert, my_msg, my_file, my_line) call shr_assert(assert, msg=my_msg, file=my_file, line=my_line)
+#define SHR_ASSERT_ALL(assert, my_msg) call shr_assert_all(assert, msg=my_msg)
+#define SHR_ASSERT_ALL_FL(assert, my_file, my_line) call shr_assert_all(assert, file=my_file, line=my_line)
+#define SHR_ASSERT_ALL_MFL(assert, my_msg, my_file, my_line) call shr_assert_all(assert, msg=my_msg, file=my_file, line=my_line)
+#define SHR_ASSERT_ANY(assert, my_msg) call shr_assert_any(assert, msg=my_msg)
+#define SHR_ASSERT_ANY_FL(assert, my_file, my_line) call shr_assert_any(assert, file=my_file, line=my_line)
+#define SHR_ASSERT_ANY_MFL(assert, my_msg, my_file, my_line) call shr_assert_any(assert, msg=my_msg, file=my_file, line=my_line)
 #endif
 use shr_assert_mod

share/csm_share/shr/shr_assert_mod.F90.in

@@ -16,6 +16,8 @@ use shr_log_mod, only: &
 
 use shr_infnan_mod, only: shr_infnan_isnan
 
+use shr_strconvert_mod, only: toString
+
 implicit none
 private
 save
@@ -66,38 +68,64 @@ end interface
 
 contains
 
-subroutine shr_assert(var, msg)
+subroutine shr_assert(var, msg, file, line)
 
-  ! Logical being asserted.
+  ! Logical being asserted
   logical, intent(in) :: var
-  ! Optional error message if assert fails.
-  character(len=*), intent(in) :: msg
-
-  if (.not. var) call shr_sys_abort(msg)
+  ! Optional error message if assert fails
+  character(len=*), intent(in), optional :: msg
+  ! Optional file and line of the caller, written out if given
+  ! (line is ignored if file is absent)
+  character(len=*), intent(in), optional :: file
+  integer         , intent(in), optional :: line
+
+  character(len=:), allocatable :: full_msg
+
+  if (.not. var) then
+     full_msg = 'ERROR'
+     if (present(file)) then
+        full_msg = full_msg // ' in ' // trim(file)
+        if (present(line)) then
+           full_msg = full_msg // ' at line ' // toString(line)
+        end if
+     end if
+     if (present(msg)) then
+        full_msg = full_msg // ': ' // msg
+     end if
+     call shr_sys_abort(full_msg)
+  end if
 
 end subroutine shr_assert
 
 ! DIMS 1,2,3,4,5,6,7
-subroutine shr_assert_all_{DIMS}d(var, msg)
+subroutine shr_assert_all_{DIMS}d(var, msg, file, line)
 
-  ! Logical being asserted.
+  ! Logical being asserted
   logical, intent(in) :: var{DIMSTR}
-  ! Optional error message if assert fails.
-  character(len=*), intent(in) :: msg
+  ! Optional error message if assert fails
+  character(len=*), intent(in), optional :: msg
+  ! Optional file and line of the caller, written out if given
+  ! (line is ignored if file is absent)
+  character(len=*), intent(in), optional :: file
+  integer         , intent(in), optional :: line
 
-  call shr_assert(all(var), msg)
+  call shr_assert(all(var), msg=msg, file=file, line=line)
 
 end subroutine shr_assert_all_{DIMS}d
 
 ! DIMS 1,2,3,4,5,6,7
-subroutine shr_assert_any_{DIMS}d(var, msg)
+subroutine shr_assert_any_{DIMS}d(var, msg, file, line)
 
-  ! Logical being asserted.
+  ! Logical being asserted
   logical, intent(in) :: var{DIMSTR}
-  ! Optional error message if assert fails.
-  character(len=*), intent(in) :: msg
+  ! Optional error message if assert fails
+  character(len=*), intent(in), optional :: msg
+  ! Optional file and line of the caller, written out if given
+  ! (line is ignored if file is absent)
+  character(len=*), intent(in), optional :: file
+  integer         , intent(in), optional :: line
 
-  call shr_assert(any(var), msg)
+  call shr_assert(any(var), msg=msg, file=file, line=line)
 
 end subroutine shr_assert_any_{DIMS}d
 

share/csm_share/shr/shr_log_mod.F90

@@ -53,6 +53,13 @@ module shr_log_mod
 !     \newline
 !     errMsg = shr\_log\_errMsg(__FILE__, __LINE__)
 !
+! This is meant to be used when a routine expects a string argument for some message,
+! but you want to provide file and line information.
+!
+! However: Note that the performance of this function can be very bad. It is currently
+! maintained because it is used by old code, but you should probably avoid using this
+! in new code if possible.
+!
 ! !REVISION HISTORY:
 !     2013-July-23 - Bill Sacks
 !

share/csm_share/shr/shr_string_mod.F90

@@ -1732,7 +1732,7 @@ function shr_string_listCreateField( numFields, strBase ) result ( retString )
    ! this assert isn't that accurate since it counts all integers as being one
    ! digit, but it should catch most errors and under rather than overestimates
    !
-   SHR_ASSERT( ( ( ( len(strBase) + 3 ) * numFields ) <= 1024 ) , errMsg(__FILE__, __LINE__) )
+   SHR_ASSERT_FL( ( ( ( len(strBase) + 3 ) * numFields ) <= 1024 ) , __FILE__, __LINE__)
 
    retString = ''
    do idx = 1,numFields

share/csm_share/test/unit/shr_assert_test/test_assert.pf

@@ -22,9 +22,15 @@ end subroutine assert_can_pass
 @Test
 subroutine assert_can_fail()
   call shr_assert(.false., "Expected failure.")
-  call assertExceptionRaised("ABORTED: Expected failure.")
+  call assertExceptionRaised("ABORTED: ERROR: Expected failure.")
 end subroutine assert_can_fail
 
+@Test
+subroutine assert_prints_file_and_line()
+  call shr_assert(.false., "Expected failure.", file='foo', line=42)
+  call assertExceptionRaised("ABORTED: ERROR in foo at line 42: Expected failure.")
+end subroutine assert_prints_file_and_line
+
 @Test
 subroutine assert_all_scalar_can_pass()
   call shr_assert_all(.true., "Assert unexpectedly aborted!")
@@ -33,7 +39,7 @@ end subroutine assert_all_scalar_can_pass
 @Test
 subroutine assert_all_scalar_can_fail()
   call shr_assert_all(.false., "Expected failure.")
-  call assertExceptionRaised("ABORTED: Expected failure.")
+  call assertExceptionRaised("ABORTED: ERROR: Expected failure.")
 end subroutine assert_all_scalar_can_fail
 
 @Test
@@ -44,7 +50,7 @@ end subroutine assert_any_scalar_can_pass
 @Test
 subroutine assert_any_scalar_can_fail()
   call shr_assert_any(.false., "Expected failure.")
-  call assertExceptionRaised("ABORTED: Expected failure.")
+  call assertExceptionRaised("ABORTED: ERROR: Expected failure.")
 end subroutine assert_any_scalar_can_fail
 
 end module test_assert

share/csm_share/test/unit/shr_assert_test/test_assert_array.pf

@@ -73,7 +73,7 @@ subroutine assert_all_can_fail(this)
   class(TestAssertArray), intent(inout) :: this
   call assert_all_wrapper([.false.], 1, this%rank, &
        "Expected failure.")
-  call assertExceptionRaised("ABORTED: Expected failure.")
+  call assertExceptionRaised("ABORTED: ERROR: Expected failure.")
 end subroutine assert_all_can_fail
 
 @Test
@@ -84,15 +84,15 @@ subroutine assert_all_partial_false_fails(this)
   test_array = [( mod(i,2) == 0, i = 1, size(test_array) )]
   call assert_all_wrapper(test_array, 2, this%rank, &
        "Expected failure.")
-  call assertExceptionRaised("ABORTED: Expected failure.")
+  call assertExceptionRaised("ABORTED: ERROR: Expected failure.")
 end subroutine assert_all_partial_false_fails
 
 @Test
 subroutine assert_any_size_zero_fails(this)
   class(TestAssertArray), intent(inout) :: this
   call assert_any_wrapper([logical::], 0, this%rank, &
        "Expected failure.")
-  call assertExceptionRaised("ABORTED: Expected failure.")
+  call assertExceptionRaised("ABORTED: ERROR: Expected failure.")
 end subroutine assert_any_size_zero_fails
 
 @Test
@@ -107,7 +107,7 @@ subroutine assert_any_can_fail(this)
   class(TestAssertArray), intent(inout) :: this
   call assert_any_wrapper([.false.], 1, this%rank, &
        "Expected failure.")
-  call assertExceptionRaised("ABORTED: Expected failure.")
+  call assertExceptionRaised("ABORTED: ERROR: Expected failure.")
 end subroutine assert_any_can_fail
 
 @Test