This report is about a case where a program with no bugs in it (other than being next to useless for anything beyond displaying the compiler bug).
The code is shown below, and was obtained by pruning away most of the code in a real application (www.netlib.org/opt/varpro). The code has one defect: some subroutine arguments with INTENT(OUT) are left unset, but those undefined variables are not used later. FTN95 7.2 displays no errors when this code is run with or without /check. With FTN95 8.10 the code runs fine with no error messages, when /check is NOT used. When /check is used in 32-bit mode, this spurious error message is displayed in a pop-up:
*** Error 14, Attempt to alter an actual argument that is a constant, an expression, an INTENT(IN) argument, or a DO variable
VARP_MOD!VPDPA - in file varp.f90 at line 55 [+0231]
On Line-55 we see the statement 'rnew=0', and note that RNEW is an argument with INTENT(OUT), and the actual argument in the caller is a local variable. Running the same EXE inside SDBG, we find that the program runs to completion without the abort occurring.
A remarkable property of this bug is that it is very fragile. Many unrelated changes, such as removing the unnecessary OPEN statement for a file that is never read from, removing the declarations of unused local variables, removing subroutines that never get called, etc., cause the bug to go away. We could call this an Anti-Heisenbug -- a bug that exists only when you hunt for it.
FTN95 8.10 does not exhibit this error in 64-bit mode.
The source code for the module:
MODULE varp_mod
IMPLICIT NONE
INTEGER, PARAMETER :: dp = kind(0d0)
CONTAINS
SUBROUTINE varpro (l, nl, n, nmax, lpp2, iv, t, y, w, a, &
iprint, alf, beta, ierr)
!
INTEGER, INTENT(IN) :: l, nl, n, nmax, lpp2, iv
REAL (dp), INTENT(IN) :: t(:,:), y(:)
REAL (dp), INTENT(IN OUT) :: w(:), alf(:), beta(:)
REAL (dp), INTENT(OUT) :: a(:,:)
INTEGER, INTENT(IN) :: iprint
INTEGER, INTENT(OUT) :: ierr
! Local variables
REAL (dp) :: acum, gnstep, nu, prjres, r, rnew
INTEGER :: b1, isel, isub, iter, iterin, j, jsub, k, ksub, lnl2, lp1, &
modit, nlp1
LOGICAL :: skip
ierr = 1
iter = 0
lp1 = l + 1
b1 = l + 2
lnl2 = l + nl + 2
nlp1 = nl + 1
skip = .false.
modit = iprint
IF (iprint <= 0) modit = 50 + 2
nu = 1.d0
CALL vpdpa (l, nl, n, nmax, lpp2, iv, t, y, w, alf, &
iprint, a, beta, a(:,lp1),rnew)
stop
CALL vpfac1 (nlp1, iprint, a(:,b1:), prjres)
CALL vpdpa (l, nl, n, nmax, lpp2, iv, t, y, w, a(:,1), &
iprint, a, beta, a(:,lp1),rnew)
stop
END SUBROUTINE varpro
!
SUBROUTINE vpdpa (l, nl, n, nmax, lpp2, iv, t, y, w, alf, &
iprint, a, u, r, rnew)
INTEGER, INTENT(IN) :: l,nl,n,nmax,lpp2,iv,iprint
REAL (dp), INTENT(IN) :: t(:,:),y(:)
REAL (dp), INTENT(IN OUT) :: w(:),alf(:),u(:)
REAL (dp), INTENT(OUT) :: a(:,:), r(:), rnew
rnew=0
print *,'In Vpdpa'
RETURN
END SUBROUTINE vpdpa
!
SUBROUTINE vpfac1 (nlp1, iprint, b, prjres)
INTEGER, INTENT(IN) :: nlp1, iprint
REAL (dp), INTENT(IN OUT) :: b(:,:)
REAL (dp), INTENT(OUT) :: prjres
print *,'In vpfac1, nlp1 = ',nlp1
END SUBROUTINE vpfac1
END MODULE varp_mod
The source for the program that USEs this module is given in the next 'response' (because of Forum posting size limits).