forums.silverfrost.com Forum Index forums.silverfrost.com
Welcome to the Silverfrost forums
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Valid code built with /64 leads to access violations

 
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> 64-bit
View previous topic :: View next topic  
Author Message
mecej4



Joined: 31 Oct 2006
Posts: 1410

PostPosted: Mon Sep 07, 2020 12:51 pm    Post subject: Valid code built with /64 leads to access violations Reply with quote

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".

Code:
! 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
Back to top
View user's profile Send private message
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 6509
Location: Salford, UK

PostPosted: Mon Sep 07, 2020 1:09 pm    Post subject: Reply with quote

Thank you for the feedback. I have made a note of this.
Back to top
View user's profile Send private message AIM Address
mecej4



Joined: 31 Oct 2006
Posts: 1410

PostPosted: Wed Sep 09, 2020 6:22 pm    Post subject: Reply with quote

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.

Code:
    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
Back to top
View user's profile Send private message
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 6509
Location: Salford, UK

PostPosted: Thu Sep 10, 2020 10:58 am    Post subject: Reply with quote

The failure with /CHECK in program sim_pop has now been fixed for the next release of FTN95.
Back to top
View user's profile Send private message AIM Address
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 6509
Location: Salford, UK

PostPosted: Sat Sep 12, 2020 4:30 pm    Post subject: Reply with quote

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

Code:
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...

Code:
do i = 1,NX
base => nodes(i)
nullify(base%l); nullify(base%r); base%v = 0
end do
Back to top
View user's profile Send private message AIM Address
Display posts from previous:   
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> 64-bit All times are GMT + 1 Hour
Page 1 of 1

 
Jump to:  
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