According to the Fortran standard, how should host-accessible variables
be treated in a recursive routine? I would have thought that only a single
instance would be created, but due to a bug, I encountered a case where
at least one compiler appears to have created a separate instance at each level.
I'll attach the actual code below, but I've also created a stripped
down version that should have similar behavior. (Not tested it, but
included it for clarity.) I am guessing that the code as written is
not standard conforming, since recursion ends up illegally modifying
the loop index "i", but one compiler got exactly the answer I
expected. (The other compiler got answers that I expected once I
declared "i" as a local variable in the contained routine.)
Thanks,
- Tom
Stripped down version:
----------------------
Subroutine foo
Implicit None
Integer :: i
Integer :: depth
Integer, Parameter :: N_CHILDREN = 4
Integer, Parameter :: MAX_DEPTH = 3
Call sub_init(0, 1)
Contains
Subroutine sub_init(depth, id)
Integer :: depth
Integer :: id
! Note accidentally forgot to declare a private variable "i"
! Implicit none does not catch this, because there is an "i" in
! the host routine.
Do i = 1, N_CHILDREN
! do something real hear with depth and id
ch_id = ...
If (depth < MAX_DEPTH) Call sub_init(depth + 1, ch_id)
End Do
End Subroutine sub_init
End Subroutine foo
Actual routine
-------------------
#define TREE_MODULE m_DummyTree
#define TREE_TYPE DummyTree
#define NODE_TYPE DummyNode
#define NODE_MODULE m_DummyNode
#define ITER_MODULE m_DummyIterator
#define ITER_TYPE DummyIterator
#include "assert.h"
Subroutine ut_tree_iter()
Use NODE_MODULE
Use TREE_MODULE
Use ITER_MODULE
Implicit None
Type (DummyTree) :: tree
Type (DummyIterator) :: iter
Integer, Parameter :: MAX_DEPTH = 3
Integer, Parameter :: N_CHILDREN = 3
Integer, Parameter :: POPULATION = (1 - N_CHILDREN**(MAX_DEPTH+1)) / (1-N_CHILDREN)
Integer :: depth_expected
Integer :: depth
Integer :: sib_expected
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
! Should have declared i here, but did not
!!! Integer :: i !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Integer :: table(0:MAX_DEPTH)
table(MAX_DEPTH) = 1
Do depth = MAX_DEPTH - 1, 0, -1
table(depth) = N_CHILDREN*table(depth+1) +1
End Do
Call init_complex_tree(tree)
Call test_Initialize(iter, tree)
Call test_Reset(iter)
i = 0
depth_expected = 0
Call test_GetDepth(iter, depth_expected)
Do
i = i + 1
depth_expected = MyDepth(i)
Call test_id(iter, i)
Call test_GetDepth(iter, depth_expected)
If (depth_expected == 0) Then
Call test_Next(iter, step = DOWN, rc_expected = SUCCESS)
depth_expected = depth_expected + 1
Cycle
End If
sib_expected = Sibling(i, depth_expected)
Call test_which(iter, sib_expected)
If (i == POPULATION) Then
Call test_Next(iter, step = DOWN, rc_expected = NO_CHILD)
Call test_Next(iter, step = OVER, rc_expected = DONE)
Exit
End If
If (depth_expected < MAX_DEPTH) Then
Call test_Next(iter, step = DOWN, rc_expected = SUCCESS)
Else
Call test_Next(iter, step = DOWN, rc_expected = NO_CHILD)
Call test_Next(iter, step = OVER, rc_expected = SUCCESS)
End If
End Do
Call test_clean(iter)
Contains
Subroutine init_complex_tree(tree)
Implicit None
Type (DummyTree) :: tree
Integer :: i_depth
Type (DummyNode), Pointer :: pnode
! top
pnode => ptrGetNode(tree)
Call Initialize(pnode, id = 1)
Call sub_init(tree, depth = 0, id = 1)
End Subroutine init_complex_tree
Recursive Subroutine sub_init(tree, depth, id)
Implicit None
Type (DummyTree) :: tree
Integer :: depth
Integer :: id
Integer :: ch_id
Integer :: i
Type (DummyTree), Pointer :: pchild
Type (DummyNode), Pointer :: pnode
ASSERT_ALWAYS(depth < MAX_DEPTH, 'beyond hard limit')
Call CreateOffspring(tree, N_CHILDREN)
Do i = 1, N_CHILDREN
pchild => ptrGetChild(tree, i)
pnode => ptrGetNode(pchild)
ch_id = id + 1 + (i-1)*table(depth+1)
Call Initialize(pnode, ch_id)
If (depth+1 < MAX_DEPTH) Call sub_init(pchild, depth + 1, ch_id)
End Do
End Subroutine sub_init
Subroutine test_Initialize(iter, tree)
Implicit None
Type (DummyIterator) :: iter
Type (DummyTree) :: tree
Call Initialize(iter, tree)
If (GetId(iter) /= 1) Write(*,*) 'failure in ut_tree_iter::test_Initialize'
End Subroutine test_Initialize
Subroutine test_Reset(iter)
Implicit None
Type (DummyIterator) :: iter
Call Reset(iter, skip = .false.)
If (GetId(iter) /= 1) Then
Write(*,*) 'failure in ut_tree_iter::test_Reset'
Write(*,*) ' Expected 1, found ',GetId(iter)
End If
End Subroutine test_Reset
Subroutine test_ptrCurrent(iter, ptree)
Implicit None
Type (DummyIterator) :: iter
Type (DummyTree), Pointer :: ptree
Type (DummyTree), Pointer :: current
current => ptrCurrent(iter)
If (.not. Associated(current, ptree)) Write(*,*) 'failure in ut_tree_iter::test_ptrCurrent'
End Subroutine test_ptrCurrent
Subroutine test_GetDepth(iter, depth)
Implicit None
Type (DummyIterator) :: iter
Integer :: depth
If (depth /= GetDepth(iter)) Then
Write(*,*)'failure in ut_tree_iter::test_GetDepth'
Write(*,*)' Expected depth = ',depth, ' found ',GetDepth(iter)
End If
End Subroutine test_GetDepth
Subroutine test_Next(iter, step, rc_expected)
Implicit None
Type (DummyIterator) :: iter
Integer, Intent(In) :: step
Integer, Intent(In) :: rc_expected
Integer :: rc_found
rc_found = Next(iter, step = step)
If (rc_expected /= rc_found) Then
Write(*,*)'failure in ut_tree_iter::test_Next'
Write(*,*)' Expected rc = ',rc_expected, ' found = ',rc_found
End If
End Subroutine test_Next
Subroutine test_Clean(iter)
Implicit None
Type (DummyIterator) :: iter
Call Clean(iter)
End Subroutine test_Clean
Subroutine test_id(iter, id)
Implicit None
Type (DummyIterator) :: iter
Integer :: id
If (id /= GetId(iter)) Then
Write(*,*)'failure in ut_tree_iter::test_id'
Write(*,*)' Expected: ',id, '; obtained ',GetId(iter)
End If
End Subroutine test_id
Integer Function GetId(iter)
Implicit None
Type (DummyIterator) :: iter
Type (DummyTree), Pointer :: current
Type (DummyNode), Pointer :: node
current => ptrCurrent(iter)
node => ptrGetNode(current)
GetId = node%id
End Function GetId
Subroutine test_which(iter, sib_expected)
Use m_DummyIterator, Only : DummyIterator
Use m_DummyIterator, Only : Which
Implicit None
Type (DummyIterator), Intent(In) :: iter
Integer, Intent(In) :: sib_expected
If (sib_expected /= Which(iter)) Write(*,*)'failure in ut_tree_iter::test_which'
End Subroutine test_which
Function Sibling(id, depth)
Implicit None
Integer, Intent(In) :: id
Integer, Intent(In) :: depth
Integer :: sibling
Integer :: d
Integer :: n, s
s = 1
n = 1
Do d = 1, depth
s = 1 + (id - 1 - n)/table(d)
n = n + (s-1) * table(d) + 1
End Do
sibling = s
End Function Sibling
Function MyDepth(id)
Integer, Intent(In) :: id
Integer :: MyDepth
Integer :: d
Integer :: n, s
s = 1
n = 1
If (n == id) Then
d = 0
Else
Do d = 1, MAX_DEPTH
s = 1 + (id - 1 - n)/table(d)
n = n + (s-1) * table(d) + 1
If (n == id) Exit
End Do
End If
MyDepth = d
End Function MyDepth
End Subroutine ut_tree_iter
--
--
Thomas Clune, Ph.D. <[log in to unmask]>
Advanced Software Technology Group Work: 301-286-4635
Science Computing Branch 931 Fax: 301-286-1634
NASA Goddard Space Flight Center
Greenbelt, MD 20771
|
