Tool to enhance ERROR STOP messages

Error stop unlike stop can be used in pure procedures and should be used to signal errors. Pure-Fortran has a script xerror_loc.py to enhance an error stop message by appending the line of the file, module, and procedure name and the values of the variables that triggered the error. For example, for the code

module m
implicit none
contains
pure function dot(x, y) result(sum_xy)
real, intent(in) :: x(:), y(:)
real :: sum_xy
if (size(x) /= size(y)) error stop "size(x) /= size(y)"
sum_xy = sum(x*y)
end function dot
end module m

program main
use m
implicit none
print*,dot([2.0], [3.0, 4.0])
end program main

python xerror_loc.py xerror_stop_dot.f90 --condition-values --run-both --out temp.f90

gives

Applied 0 location tag rewrite(s) and 1 IF-block rewrite(s) across 1 file(s).
Build (original-fortran): gfortran xerror_stop_dot.f90 -o xerror_stop_dot.original-fortran.exe
<snip>
ERROR STOP size(x) /= size(y)

<snip>
Build (transformed-fortran): gfortran
<snip> 
Build (transformed-fortran): PASS
Run (transformed-fortran): temp.transformed-fortran.exe
Run (transformed-fortran): FAIL (exit 1)
ERROR STOP size(x) /= size(y) [temp.f90::module m::function dot::line 7]: size(x) = 1,  size(y) = 2

In the error message for the transformed code, the line number of the error stop and the values of size(x) and size(y) are shown. You could print these before the error stop, but print is not allowed in pure functions. The new code around the error stop is

   block
      character(len=1000) :: msg
      write(msg, "(a,a,g0,a,g0)") &
         & "size(x) /= size(y) [temp.f90::module m::function dot::line 7]", &
         & ": size(x) = ", size(x), ", &
         & size(y) = ", size(y)
      error stop trim(msg)
   end block

Using this tool you can get detailed information about why a program stopped without using a debugger or adding print statements (which may not be allowed).

2 Likes

An error stop may be triggered by multiple conditions, as in

module m
implicit none
contains
pure subroutine mmult(a, b, c)
real, intent(in)  :: a(:,:)
real, intent(in)  :: b(:,:)
real, intent(out) :: c(:,:)
if (size(a,2) /= size(b,1) .or. size(c,1) /= size(a,1) .or. &
   size(c,2) /= size(b,2)) error stop
c = matmul(a,b)
end subroutine mmult
end module m

program main
use m, only: mmult
implicit none
integer, parameter :: na1 = 3, na2 = 4, nb2 = 5
real :: a(na1, na2), b(na2, nb2), c(na1, nb2)
call random_number(a)
call random_number(b)
call mmult(a, b, c)
print*,c(1,1)
call mmult(a, b(:, 2:), c)
print*,c(1,1)
end program main

python xerror_loc.py xmmult.f90 --specific --out temp.f90 --run

gives an error message saying which condition caused termination, for example

ERROR STOP size(c,2) /= size(b,2) [temp.f90::module m::subroutine mmult::line 8]: size(c,2) = 5,  size(b,2) = 4

for the code above. The error stop block in the transformed program is

   block
      character(len=1000) :: msg
      character(len=*), parameter :: loc = &
         & "[temp.f90::module m::subroutine mmult::line 8]"
      if (size(a,2) /= size(b,1)) then
         write(msg, "(a,a,g0,a,g0)") "size(a,2) /= size(b,1) " // loc, &
            & ": size(a,2) = ", size(a,2), ", size(b,1) = ", size(b,1)
      else if (size(c,1) /= size(a,1)) then
         write(msg, "(a,a,g0,a,g0)") "size(c,1) /= size(a,1) " // loc, &
            & ": size(c,1) = ", size(c,1), ", size(a,1) = ", size(a,1)
      else
         write(msg, "(a,a,g0,a,g0)") "size(c,2) /= size(b,2) " // loc, &
            & ": size(c,2) = ", size(c,2), ", size(b,2) = ", size(b,2)
      end if
      error stop trim(msg)
   end block

Conditions are tested successively, and the first true condition is reported. If the original error stop test uses any, instead of repeated .or., as in

if (any([size(a,2) /= size(b,1), size(c,1) /= size(a,1), &
    size(c,2) /= size(b,2)])) error stop

the same error message is given.