|
forums.silverfrost.com Welcome to the Silverfrost forums
|
View previous topic :: View next topic |
Author |
Message |
mecej4
Joined: 31 Oct 2006 Posts: 1897
|
Posted: Fri Feb 16, 2024 4:51 pm Post subject: Program hangs on entering ASSOCIATE construct |
|
|
When an "associate name" is used as an actual argument in order to pass an array section to a subprogram, FTN95 may generate code that hangs or quits abruptly, even when the /check or /undef options are used. This problem occurs with 32- as well as 64-bit EXEs.
Here is a reproducer (100 lines source + an unformatted input data file about 200 K in size, in two versions - one for FTN95, and the other for compilers that use 4-byte record markers for Fortran unformatted sequential files).
https://www.dropbox.com/scl/fi/3k5jbwaawxnlexn7vpvx6/grist.zip?rlkey=va7n5ro733atugkig3kgwhqpq&dl=0
The zip file contains instructions to build and run using (a) FTN95 and (b) another compiler, e.g., Gfortran. |
|
Back to top |
|
|
PaulLaidler Site Admin
Joined: 21 Feb 2005 Posts: 8018 Location: Salford, UK
|
Posted: Sat Feb 17, 2024 8:54 am Post subject: |
|
|
mecej4
Many thanks for the feedback. I have made a note of your report. |
|
Back to top |
|
|
mecej4
Joined: 31 Oct 2006 Posts: 1897
|
Posted: Sat Feb 17, 2024 2:01 pm Post subject: |
|
|
Paul, here is a shorter reproducer that also generates its own input data instead of reading a large input data file.
Code: | program gcgtst ! demonstrates bug(s) related to ASSOCIATE
implicit none
integer, parameter :: kdp = kind(0.0d0)
integer nrn, nbn, nxyz, i, j
real (kind=kdp), allocatable :: rhs(:), xx(:), w(:), rr(:), va(:, :)
integer, allocatable :: ci(:, :)
call getint(nrn) ! get integer in range 1-9999 from command line argument
nbn = nrn
nxyz = nrn+nbn
allocate (rhs(nxyz), xx(nxyz), va(7,nxyz), ci(6,nxyz), w(nbn), rr(nbn))
do i = 1, nxyz
xx(i) = real(i)/nxyz
va(:,i) = [(j*xx(i), j=1,7)]
end do
ci = 0
call gcgr()
contains
subroutine getint(n)
use iso_fortran_env
implicit none
integer, intent(out) :: n
character(len=4) :: str
character(len=1), parameter :: sl = '/'
if(command_argument_count() .eq. 1)then
call get_command_argument(1, str)
read (str,'(I4)')n
else
n = 80
endif
print '(a,A1,a,A1,4x,i5)', compiler_version(),sl, compiler_options(),sl,n
return
end subroutine getint
subroutine gcgr()
implicit none
integer nrnp1
nrnp1 = nrn + 1
associate (rhs_r => rhs(1:nrn), rhs_b => rhs(nrnp1:nxyz), & ! rhs_r and rhs_b never used again
xx_b => xx(nrnp1:nxyz)) ! undef. var. reported here!
rr = 0.0
call armult(w, rr) ! w is never used again; this call could be commented out, but that kills bug
call dbmult(rr, xx_b)
end associate
print '(1x,5ES12.4)', rr(1:min(5,nbn))
return
end subroutine gcgr
subroutine dbmult(x, y)
implicit none
real (kind=kdp), dimension (:), intent (out) :: x
real (kind=kdp), dimension (:), intent (in) :: y
integer :: i, j
do i = 1, nbn
j = i + nrn
x(i) = y(i)*va(7, j)
end do
end subroutine dbmult
subroutine armult(x, y)
implicit none
real (kind=kdp), dimension (:), intent (out) :: x
real (kind=kdp), dimension (:), intent (in) :: y
integer :: i, ii, j, jcol
real (kind=kdp) :: s
do i = 1, nbn
ii = i + nrn
s = 0.0_kdp
do j = 1, 6
jcol = ci(j, ii)
if (jcol>0) s = s + va(j, ii)*y(jcol) ! never executed since ci = 0
end do
x(i) = s ! when ci == 0, x(:) is set to 0
end do
end subroutine armult
end program |
[post limit reached, continued in next post] |
|
Back to top |
|
|
mecej4
Joined: 31 Oct 2006 Posts: 1897
|
Posted: Sat Feb 17, 2024 2:04 pm Post subject: |
|
|
[continued from previous post]
This program may be compiled and linked with several compiler options. The compiled program may be run with one command line argument -- an integer from 1 to 9999. If no argument is provided, the program uses 80. The program is bug free (as far as I know, after testing with other compilers with checking turned on). Here are a few of the peculiar symptoms displayed:
Display compiler information, results (5 real numbers) and terminate (expected, normal)
Display compiler information and hang
Display compiler information, results and hang
Display pop-up for access violation
If compiled with /undef, flag spurious error (undefined variable used) with pop up window.
The last item merits some discussion. I think that the compiler implements ASSOCIATE by making a temporary copy. While doing so, if /undef has been specified, making the copy triggers "undefined". Strictly speaking, the user's program did not itself access the undefined variable, but passed a reference to it. The NAG compiler, with -C=undefined, seems to agree.
These circumstances are rather tough to negotiate for the compiler, so users need to be forgiving, I think. On the other hand, if the compiler knows that copy-in/copy-out is something to which it cannot reliably apply /undef checking, perhaps it could skip that checking for just those lines of code that trigger copy-in/copy out. |
|
Back to top |
|
|
PaulLaidler Site Admin
Joined: 21 Feb 2005 Posts: 8018 Location: Salford, UK
|
Posted: Mon Feb 19, 2024 8:30 am Post subject: |
|
|
mecej4
Many thanks for the new code which is a great help. |
|
Back to top |
|
|
PaulLaidler Site Admin
Joined: 21 Feb 2005 Posts: 8018 Location: Salford, UK
|
Posted: Wed Feb 28, 2024 10:19 am Post subject: |
|
|
FTN95 does not currently implement pointers to array sections within an ASSOCIATE statement. This feature has now been added for the next release of FTN95 but it has not yet been tested on the above code.
p.s. The above test program appears to run successfully. |
|
Back to top |
|
|
mecej4
Joined: 31 Oct 2006 Posts: 1897
|
Posted: Wed May 15, 2024 1:46 am Post subject: |
|
|
Update on 19 May 2024:
The two test programs posted above (grist.f90 and gcgtst.f90) work correctly with FTN95 version 9.03.
Thanks to Silverfrost for enhancing the compiler to enable the ASSOCIATE construct to work with arrays. |
|
Back to top |
|
|
|
|
You cannot post new topics in this forum You cannot reply to topics in this forum You cannot edit your posts in this forum You cannot delete your posts in this forum You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|