Valid code built with /64 leads to access violations

The following test code constructs a basic binary tree out of an unsorted array of integers, and outputs the tree in sorted order. It runs without error with FTN95-32 bit, as well as with other compilers.

The 8.65 FTN95 compiler, used with /64 alone or /64 with other options, produces EXEs that abort with access violations or 'reference through unset Fortran pointer'.

! For each node, the convention is:
! If %v == 0, the node is not yet allocated and has no value or branches
! if %l is unassociated, there is no left branch
! if %l is unassociated, there is no right branch
! Duplicate values are rejected
!
module BinaryTree
type node
   type(node), pointer :: l => NULL(), r => NULL()
   integer             :: v = 0
end type
integer, parameter :: NVM = 60
type(node), target,save :: nodes(NVM)
integer :: nnodes = 0

contains

subroutine insert(anode,val,found,nnod)
implicit none
type(node), intent(in),target :: anode(*)
integer, intent(in) :: val
integer, intent(in out) :: nnod
logical, intent(out) :: found
type(node), pointer :: nd
found = .false.; nd => anode(1)
do
   if(nd%v == 0)then      ! Do not move this IF block since
      nd%v = val          ! nd%l, nd%v should not be referenced
      nnod = nnod+1       ! unless nd%v is not zero
      return
   else if(val < nd%v)then
      if(.not.associated(nd%l))then
         nnod = nnod+1
         nd%l => anode(nnod)
         nd%l%v = val
         return
      endif
      nd => nd%l
   else if(val > nd%v)then
      if(.not.associated(nd%r))then
         nnod = nnod+1
         nd%r => anode(nnod)
         nd%r%v = val
         return
      endif
      nd => nd%r
   else if(val == nd%v)then
      found = .true.
      return
   endif
end do
stop 'Should not have reached this line at end of Subroutine INSERT!'
end subroutine insert

recursive subroutine ptree(base)
type(node) :: base
if(base%v == 0)return
if(associated(base%l))call ptree(base%l);
write(*,'(i5)',advance='no')base%v
if(associated(base%r))call ptree(base%r);
return
end subroutine

end module

program tst
use BinaryTree
implicit none
integer, parameter :: NX = 15
integer, dimension(NX) :: vals = &
   [172, 97,  2,166,189, 91, 27, 23,156, 64,113, 29,173,172,114]
type(node), pointer :: base
logical :: found
integer :: i
!
base => nodes(1)
nullify(base%l); nullify(base%r); base%v = 0
nnodes = 0
print '(A,/,15i5,/)','Unsorted array:',vals

do i = 1,NX
   call insert(nodes,vals(i),found,nnodes)
   if(found)print *,'Value ',vals(i),' already in tree, not inserted'
end do
print *
print *,'Sorted  array, duplicates removed:'
call ptree(nodes(1))
end program

Thank you for the feedback. I have made a note of this.

Here is a variant of the same program which yields the opposite kind of behavior. This program is also error free, and runs fine with /64 or /p6, but aborts with spurious errors when compiled with /check, with or without /64.

    PROGRAM sim_pop
       IMPLICIT NONE
       TYPE node
          TYPE (node), POINTER :: l, r
          INTEGER :: v
       END TYPE
       TYPE (node), DIMENSION (:, :), ALLOCATABLE, TARGET :: visite
       INTEGER :: n, day, days, uscite, usc, nnode, ierror
       INTEGER :: vals(16)=(/ 1511, 2879, 1519,  754,  912, &
                               902, 1658,    2, 1076, 1661, &
                               763,   11, 4224, 1052, 1234,  627 /)
!
       n = 150
       days = 1
       usc = 16
       ALLOCATE (visite(1:usc,n*n), STAT = ierror)
       IF (ierror /= 0) THEN
          WRITE (*, *) 'Error allocating VISITE(:,:), stat = ',ierror
          STOP
       END IF
       DO day = 1, days                          ! This loop runs only once.
          visite(:, :) = node(null(), null(), 0) ! Removing the DO..END DO makes the bug disappear
          nnode = 0
          uscite = 1
          DO WHILE (uscite <= usc)
             print *,uscite, vals(uscite)
             CALL insert (visite(1,1),vals(uscite),nnode)
             uscite = uscite + 1
          END DO !while
       END DO !day
       call ptree(visite(1,1))
       STOP
!
    CONTAINS

       SUBROUTINE insert(anode, val, nnod)
          IMPLICIT NONE
          TYPE (node), INTENT (IN OUT), TARGET :: anode(*)
          INTEGER, INTENT (IN) :: val
          INTEGER, INTENT (IN OUT) :: nnod
          TYPE (node), POINTER :: nd

          nd => anode(1)
          DO
             IF (nd%v == 0) THEN ! Do not move this IF block since
                nd%v = val       ! nd%l, nd%v should not be referenced
                nnod = nnod + 1  ! unless nd%v is not zero
                RETURN
             ELSE IF (val < nd%v) THEN
                IF (.NOT. associated(nd%l)) THEN
                   nd%l => anode(nnod+1)
                END IF
                nd => nd%l
             ELSE IF (val > nd%v) THEN
                IF (.NOT. associated(nd%r)) THEN
                   nd%r => anode(nnod+1)
                END IF
                nd => nd%r
             ELSE IF (val == nd%v) THEN
                RETURN
             END IF
          END DO
       END SUBROUTINE

       RECURSIVE SUBROUTINE ptree(base)
          TYPE (node) :: base

          IF (base%v == 0) RETURN
          IF (associated(base%l)) CALL ptree(base%l)
          WRITE (*, '(1x,i6)', ADVANCE='no') base%v
          IF (associated(base%r)) CALL ptree(base%r)
          RETURN
       END SUBROUTINE

    END PROGRAM

The failure with /CHECK in program sim_pop has now been fixed for the next release of FTN95.

The FTN95 failure in the first program (tst) is that the line

type(node), pointer :: l => NULL(), r => NULL()

is not working. It probably doesn't work for 32 bits either but the default values are presumably OK.

A temporary work-around is to nullify these values in a different way, for example...

do i = 1,NX
base => nodes(i)
nullify(base%l); nullify(base%r); base%v = 0
end do

This bug has now been fixed for the next release of FTN95.