在 Fortran 中使用树和指针
Working with trees and pointers in Fortran
我一直在研究一个 Fortran 95 程序，它试图猜测您在想什么。它需要一个包含 id label question yes no:
形式的行的文件
9
1 . Is_it_a_living_thing? 2 7
2 . Can_it_walk? 3 6
3 . Does_it_meow? 4 5
4 a_cat . 0 0
5 David_Mitchell . 0 0
6 a_bacteria . 0 0
7 . Is_it_electrical? 8 9
8 a_toaster . 0 0
9 hair_gel . 0 0
下划线的原因是我编写的这个程序的C实现，阅读时很高兴与Fortran格式配合使用。代码如下：
module types
implicit none
type node
character (len = 32) :: label
character (len = 128) :: question
type(node), pointer :: yes, no
end type node
end module types
program pangolins
use types
implicit none
!type(node), allocatable :: nodes(:)
type(node), pointer :: head, current
! Program
head => parseFile()
nullify(current)
call freeAll(head)
stop
contains
function parseFile() result(head)
implicit none
type(node), pointer :: nodes(:)
type(node), pointer :: head
integer :: i, n, thisN, thisYes, thisNo
character (len = 32) :: thisLabel
character (len = 128) :: thisQuestion
open(10, file = './file1')
read(10, *) n
write(*, *) 'Nodes: ', n
allocate(nodes(n))
do i = 1, n
read(10, *) thisN, thisLabel, thisQuestion, thisYes, thisNo
write (*,'(a24,a64,i4,i4)') thisLabel, thisQuestion, thisYes, thisNo
nodes(i)%label = thisLabel
nodes(i)%question = thisQuestion
if (thisYes .eq. 0) then
nullify(nodes(i)%yes)
else
nodes(i)%yes => nodes(thisYes)
end if
if (thisNo .eq. 0) then
nullify(nodes(i)%no)
else
nodes(i)%no => nodes(thisNo)
end if
end do
head => nodes(1)
end function parseFile
recursive subroutine freeAll(head)
implicit none
type(node), pointer :: head
if (associated(head%yes)) then
call freeAll(head%yes)
end if
if (associated(head%no)) then
call freeAll(head%no)
end if
write (*,'(a24,a64)') head%label, head%question
deallocate(head)
end subroutine freeAll
end program pangolins
目前代码只是初始化数组，然后再次尝试干净地释放它。
问题与指向数组和数组元素的指针有关。我的函数 parseFile 通过首先将文件中的节点解析为指针数组并通过数组中的索引指向 yes 和 no 指针，然后返回第一个元素，该元素始终是树。这在 C 语言中很直观，我就是从这里来的。
当我运行这段代码时，在freeAll()中对deallocate()的第二次调用导致双重空闲段错误。
我怀疑我将它与使用指针数组的 C 版本混淆了，因此虽然我将起始节点初始化为数组，但我可以使用顺序遍历一次释放每个指针自初始化以来，树可能变大了，然后最终释放了数组。这是我一直试图从 C:
移植的函数
...
node_t* readFile(FILE* inFile)
{
int noOfNodes;
fscanf(inFile, "%d", &noOfNodes);
node_t** nodes = (node_t**) malloc(sizeof(node_t*) * noOfNodes);
for (int i = 0; i < noOfNodes; i++)
nodes[i] = (node_t*) malloc(sizeof(node_t));
char* nodeLabel = (char*) malloc(sizeof(char) * MAX_LABEL_SIZE);
char* nodeQuestion = (char*) malloc(sizeof(char) * MAX_QUESTION_SIZE);
...
我错过了什么？回溯如下：
$ gfortran -pedantic -Wall -ggdb -fbacktrace -fcheck=all -o pangolins pangolins.f95
pangolins.f95:65.6:
head => nodes(1)
1
Warning: Pointer at (1) in pointer assignment might outlive the pointer target
$ ./pangolins
Nodes: 9
. Is_it_a_living_thing? 2 7
. Can_it_walk? 3 6
. Does_it_meow? 4 5
a_cat . 0 0
David_Mitchell . 0 0
a_bacteria . 0 0
. Is_it_electrical? 8 9
a_toaster . 0 0
hair_gel . 0 0
a_cat .
*** Error in `./pangolins': double free or corruption (out): 0x0000000000858700 ***
======= Backtrace: =========
/lib64/libc.so.6[0x3055875a4f]
/lib64/libc.so.6[0x305587cd78]
./pangolins[0x400d7d]
./pangolins[0x400c70]
./pangolins[0x400c70]
./pangolins[0x400c70]
./pangolins[0x400ddf]
./pangolins[0x4018b6]
/lib64/libc.so.6(__libc_start_main+0xf5)[0x3055821d65]
./pangolins[0x400b69]
======= Memory map: ========
00400000-00402000 r-xp 00000000 08:03 5636403 /home/adam/utils/fortran/pangolins
00602000-00603000 r--p 00002000 08:03 5636403 /home/adam/utils/fortran/pangolins
00603000-00604000 rw-p 00003000 08:03 5636403 /home/adam/utils/fortran/pangolins
00853000-00874000 rw-p 00000000 00:00 0 [heap]
3055400000-3055420000 r-xp 00000000 08:03 4459030 /usr/lib64/ld-2.18.so
305561f000-3055620000 r--p 0001f000 08:03 4459030 /usr/lib64/ld-2.18.so
3055620000-3055621000 rw-p 00020000 08:03 4459030 /usr/lib64/ld-2.18.so
3055621000-3055622000 rw-p 00000000 00:00 0
3055800000-30559b4000 r-xp 00000000 08:03 4499543 /usr/lib64/libc-2.18.so
30559b4000-3055bb3000 ---p 001b4000 08:03 4499543 /usr/lib64/libc-2.18.so
3055bb3000-3055bb7000 r--p 001b3000 08:03 4499543 /usr/lib64/libc-2.18.so
3055bb7000-3055bb9000 rw-p 001b7000 08:03 4499543 /usr/lib64/libc-2.18.so
3055bb9000-3055bbe000 rw-p 00000000 00:00 0
3056800000-3056905000 r-xp 00000000 08:03 4460722 /usr/lib64/libm-2.18.so
3056905000-3056b05000 ---p 00105000 08:03 4460722 /usr/lib64/libm-2.18.so
3056b05000-3056b06000 r--p 00105000 08:03 4460722 /usr/lib64/libm-2.18.so
3056b06000-3056b07000 rw-p 00106000 08:03 4460722 /usr/lib64/libm-2.18.so
3057400000-3057415000 r-xp 00000000 08:03 4499572 /usr/lib64/libgcc_s-4.8.3-20140911.so.1
3057415000-3057614000 ---p 00015000 08:03 4499572 /usr/lib64/libgcc_s-4.8.3-20140911.so.1
3057614000-3057615000 r--p 00014000 08:03 4499572 /usr/lib64/libgcc_s-4.8.3-20140911.so.1
3057615000-3057616000 rw-p 00015000 08:03 4499572 /usr/lib64/libgcc_s-4.8.3-20140911.so.1
7fcb37dc5000-7fcb37dc9000 rw-p 00000000 00:00 0
7fcb37dc9000-7fcb37e04000 r-xp 00000000 08:03 4471039 /usr/lib64/libquadmath.so.0.0.0
7fcb37e04000-7fcb38003000 ---p 0003b000 08:03 4471039 /usr/lib64/libquadmath.so.0.0.0
7fcb38003000-7fcb38004000 r--p 0003a000 08:03 4471039 /usr/lib64/libquadmath.so.0.0.0
7fcb38004000-7fcb38005000 rw-p 0003b000 08:03 4471039 /usr/lib64/libquadmath.so.0.0.0
7fcb38005000-7fcb38006000 rw-p 00000000 00:00 0
7fcb38006000-7fcb38125000 r-xp 00000000 08:03 4470960 /usr/lib64/libgfortran.so.3.0.0
7fcb38125000-7fcb38325000 ---p 0011f000 08:03 4470960 /usr/lib64/libgfortran.so.3.0.0
7fcb38325000-7fcb38326000 r--p 0011f000 08:03 4470960 /usr/lib64/libgfortran.so.3.0.0
7fcb38326000-7fcb38328000 rw-p 00120000 08:03 4470960 /usr/lib64/libgfortran.so.3.0.0
7fcb3834b000-7fcb3834d000 rw-p 00000000 00:00 0
7ffdefd3b000-7ffdefd5c000 rw-p 00000000 00:00 0 [stack]
7ffdefd8e000-7ffdefd90000 r--p 00000000 00:00 0 [vvar]
7ffdefd90000-7ffdefd92000 r-xp 00000000 00:00 0 [vdso]
ffffffffff600000-ffffffffff601000 r-xp 00000000 00:00 0 [vsyscall]
Program received signal SIGABRT: Process abort signal.
Backtrace for this error:
#0 0x7FCB3801F497
#1 0x7FCB3801FADE
#2 0x30558358EF
#3 0x3055835877
#4 0x3055836F67
#5 0x3055875A53
#6 0x305587CD77
#7 0x400D7C in freeall at pangolins.f95:82 (discriminator 2)
#8 0x400C6F in freeall at pangolins.f95:74
#9 0x400C6F in freeall at pangolins.f95:74
#10 0x400C6F in freeall at pangolins.f95:74
#11 0x400DDE in pangolins at pangolins.f95:23
Aborted (core dumped)
第一个解除分配有效，但随后的解除分配导致了问题。请注意 write 在 deallocate().
上方打印的第二个 a_cat
函数 parseFile 中的函数结果 head 与数组的一个元素相关联。虽然元素所属的数组是分配的指针目标，但元素本身不是。
作为函数结果的指针最终作为 freeAll 子例程的参数结束。在 freeAll 中，您然后释放该指针引用的东西 - 也就是说您正在释放一些不是已分配的东西。这是一个编程错误。
如果要解除分配 nodes 数组在 parseFile 函数中关联的指针目标，则需要解除分配数组。也许函数的结果和子程序的参数应该是一个数组。
（在C中，指向数组第一个元素的指针可以代表整个数组。除了序列关联之类的东西，Fortran中不是这种情况。）
(一个 style/safe 编程问题 - 您应该考虑使用 parseFile 的子例程而不是函数 - 函数通常用于表达式（不适用于此函数，做 IO) 并且 return 指针结果的函数很容易出错，因此只有在出于其他原因需要时才应使用它们。)
我一直在研究一个 Fortran 95 程序，它试图猜测您在想什么。它需要一个包含 id label question yes no:
9
1 . Is_it_a_living_thing? 2 7
2 . Can_it_walk? 3 6
3 . Does_it_meow? 4 5
4 a_cat . 0 0
5 David_Mitchell . 0 0
6 a_bacteria . 0 0
7 . Is_it_electrical? 8 9
8 a_toaster . 0 0
9 hair_gel . 0 0
下划线的原因是我编写的这个程序的C实现，阅读时很高兴与Fortran格式配合使用。代码如下：
module types
implicit none
type node
character (len = 32) :: label
character (len = 128) :: question
type(node), pointer :: yes, no
end type node
end module types
program pangolins
use types
implicit none
!type(node), allocatable :: nodes(:)
type(node), pointer :: head, current
! Program
head => parseFile()
nullify(current)
call freeAll(head)
stop
contains
function parseFile() result(head)
implicit none
type(node), pointer :: nodes(:)
type(node), pointer :: head
integer :: i, n, thisN, thisYes, thisNo
character (len = 32) :: thisLabel
character (len = 128) :: thisQuestion
open(10, file = './file1')
read(10, *) n
write(*, *) 'Nodes: ', n
allocate(nodes(n))
do i = 1, n
read(10, *) thisN, thisLabel, thisQuestion, thisYes, thisNo
write (*,'(a24,a64,i4,i4)') thisLabel, thisQuestion, thisYes, thisNo
nodes(i)%label = thisLabel
nodes(i)%question = thisQuestion
if (thisYes .eq. 0) then
nullify(nodes(i)%yes)
else
nodes(i)%yes => nodes(thisYes)
end if
if (thisNo .eq. 0) then
nullify(nodes(i)%no)
else
nodes(i)%no => nodes(thisNo)
end if
end do
head => nodes(1)
end function parseFile
recursive subroutine freeAll(head)
implicit none
type(node), pointer :: head
if (associated(head%yes)) then
call freeAll(head%yes)
end if
if (associated(head%no)) then
call freeAll(head%no)
end if
write (*,'(a24,a64)') head%label, head%question
deallocate(head)
end subroutine freeAll
end program pangolins
目前代码只是初始化数组，然后再次尝试干净地释放它。
问题与指向数组和数组元素的指针有关。我的函数 parseFile 通过首先将文件中的节点解析为指针数组并通过数组中的索引指向 yes 和 no 指针，然后返回第一个元素，该元素始终是树。这在 C 语言中很直观，我就是从这里来的。
当我运行这段代码时，在freeAll()中对deallocate()的第二次调用导致双重空闲段错误。
我怀疑我将它与使用指针数组的 C 版本混淆了，因此虽然我将起始节点初始化为数组，但我可以使用顺序遍历一次释放每个指针自初始化以来，树可能变大了，然后最终释放了数组。这是我一直试图从 C:
移植的函数...
node_t* readFile(FILE* inFile)
{
int noOfNodes;
fscanf(inFile, "%d", &noOfNodes);
node_t** nodes = (node_t**) malloc(sizeof(node_t*) * noOfNodes);
for (int i = 0; i < noOfNodes; i++)
nodes[i] = (node_t*) malloc(sizeof(node_t));
char* nodeLabel = (char*) malloc(sizeof(char) * MAX_LABEL_SIZE);
char* nodeQuestion = (char*) malloc(sizeof(char) * MAX_QUESTION_SIZE);
...
我错过了什么？回溯如下：
$ gfortran -pedantic -Wall -ggdb -fbacktrace -fcheck=all -o pangolins pangolins.f95
pangolins.f95:65.6:
head => nodes(1)
1
Warning: Pointer at (1) in pointer assignment might outlive the pointer target
$ ./pangolins
Nodes: 9
. Is_it_a_living_thing? 2 7
. Can_it_walk? 3 6
. Does_it_meow? 4 5
a_cat . 0 0
David_Mitchell . 0 0
a_bacteria . 0 0
. Is_it_electrical? 8 9
a_toaster . 0 0
hair_gel . 0 0
a_cat .
*** Error in `./pangolins': double free or corruption (out): 0x0000000000858700 ***
======= Backtrace: =========
/lib64/libc.so.6[0x3055875a4f]
/lib64/libc.so.6[0x305587cd78]
./pangolins[0x400d7d]
./pangolins[0x400c70]
./pangolins[0x400c70]
./pangolins[0x400c70]
./pangolins[0x400ddf]
./pangolins[0x4018b6]
/lib64/libc.so.6(__libc_start_main+0xf5)[0x3055821d65]
./pangolins[0x400b69]
======= Memory map: ========
00400000-00402000 r-xp 00000000 08:03 5636403 /home/adam/utils/fortran/pangolins
00602000-00603000 r--p 00002000 08:03 5636403 /home/adam/utils/fortran/pangolins
00603000-00604000 rw-p 00003000 08:03 5636403 /home/adam/utils/fortran/pangolins
00853000-00874000 rw-p 00000000 00:00 0 [heap]
3055400000-3055420000 r-xp 00000000 08:03 4459030 /usr/lib64/ld-2.18.so
305561f000-3055620000 r--p 0001f000 08:03 4459030 /usr/lib64/ld-2.18.so
3055620000-3055621000 rw-p 00020000 08:03 4459030 /usr/lib64/ld-2.18.so
3055621000-3055622000 rw-p 00000000 00:00 0
3055800000-30559b4000 r-xp 00000000 08:03 4499543 /usr/lib64/libc-2.18.so
30559b4000-3055bb3000 ---p 001b4000 08:03 4499543 /usr/lib64/libc-2.18.so
3055bb3000-3055bb7000 r--p 001b3000 08:03 4499543 /usr/lib64/libc-2.18.so
3055bb7000-3055bb9000 rw-p 001b7000 08:03 4499543 /usr/lib64/libc-2.18.so
3055bb9000-3055bbe000 rw-p 00000000 00:00 0
3056800000-3056905000 r-xp 00000000 08:03 4460722 /usr/lib64/libm-2.18.so
3056905000-3056b05000 ---p 00105000 08:03 4460722 /usr/lib64/libm-2.18.so
3056b05000-3056b06000 r--p 00105000 08:03 4460722 /usr/lib64/libm-2.18.so
3056b06000-3056b07000 rw-p 00106000 08:03 4460722 /usr/lib64/libm-2.18.so
3057400000-3057415000 r-xp 00000000 08:03 4499572 /usr/lib64/libgcc_s-4.8.3-20140911.so.1
3057415000-3057614000 ---p 00015000 08:03 4499572 /usr/lib64/libgcc_s-4.8.3-20140911.so.1
3057614000-3057615000 r--p 00014000 08:03 4499572 /usr/lib64/libgcc_s-4.8.3-20140911.so.1
3057615000-3057616000 rw-p 00015000 08:03 4499572 /usr/lib64/libgcc_s-4.8.3-20140911.so.1
7fcb37dc5000-7fcb37dc9000 rw-p 00000000 00:00 0
7fcb37dc9000-7fcb37e04000 r-xp 00000000 08:03 4471039 /usr/lib64/libquadmath.so.0.0.0
7fcb37e04000-7fcb38003000 ---p 0003b000 08:03 4471039 /usr/lib64/libquadmath.so.0.0.0
7fcb38003000-7fcb38004000 r--p 0003a000 08:03 4471039 /usr/lib64/libquadmath.so.0.0.0
7fcb38004000-7fcb38005000 rw-p 0003b000 08:03 4471039 /usr/lib64/libquadmath.so.0.0.0
7fcb38005000-7fcb38006000 rw-p 00000000 00:00 0
7fcb38006000-7fcb38125000 r-xp 00000000 08:03 4470960 /usr/lib64/libgfortran.so.3.0.0
7fcb38125000-7fcb38325000 ---p 0011f000 08:03 4470960 /usr/lib64/libgfortran.so.3.0.0
7fcb38325000-7fcb38326000 r--p 0011f000 08:03 4470960 /usr/lib64/libgfortran.so.3.0.0
7fcb38326000-7fcb38328000 rw-p 00120000 08:03 4470960 /usr/lib64/libgfortran.so.3.0.0
7fcb3834b000-7fcb3834d000 rw-p 00000000 00:00 0
7ffdefd3b000-7ffdefd5c000 rw-p 00000000 00:00 0 [stack]
7ffdefd8e000-7ffdefd90000 r--p 00000000 00:00 0 [vvar]
7ffdefd90000-7ffdefd92000 r-xp 00000000 00:00 0 [vdso]
ffffffffff600000-ffffffffff601000 r-xp 00000000 00:00 0 [vsyscall]
Program received signal SIGABRT: Process abort signal.
Backtrace for this error:
#0 0x7FCB3801F497
#1 0x7FCB3801FADE
#2 0x30558358EF
#3 0x3055835877
#4 0x3055836F67
#5 0x3055875A53
#6 0x305587CD77
#7 0x400D7C in freeall at pangolins.f95:82 (discriminator 2)
#8 0x400C6F in freeall at pangolins.f95:74
#9 0x400C6F in freeall at pangolins.f95:74
#10 0x400C6F in freeall at pangolins.f95:74
#11 0x400DDE in pangolins at pangolins.f95:23
Aborted (core dumped)
第一个解除分配有效，但随后的解除分配导致了问题。请注意 write 在 deallocate().
a_cat
函数 parseFile 中的函数结果 head 与数组的一个元素相关联。虽然元素所属的数组是分配的指针目标，但元素本身不是。
作为函数结果的指针最终作为 freeAll 子例程的参数结束。在 freeAll 中，您然后释放该指针引用的东西 - 也就是说您正在释放一些不是已分配的东西。这是一个编程错误。
如果要解除分配 nodes 数组在 parseFile 函数中关联的指针目标，则需要解除分配数组。也许函数的结果和子程序的参数应该是一个数组。
（在C中，指向数组第一个元素的指针可以代表整个数组。除了序列关联之类的东西，Fortran中不是这种情况。）
(一个 style/safe 编程问题 - 您应该考虑使用 parseFile 的子例程而不是函数 - 函数通常用于表达式（不适用于此函数，做 IO) 并且 return 指针结果的函数很容易出错，因此只有在出于其他原因需要时才应使用它们。)