你有三个问题,正如 cmets 中所建议的那样
- 在 Fortran 中,结构组件选择器是
%,NOT .。因此您的程序包含语法错误
- 在 Fortran 中,当
allocatable 数组超出范围时,它会自动释放,除非它具有 save 属性。这是一件好事,因为这意味着使用可分配数组的内存泄漏是不可能的,但它会伤害你,因为当你退出附加例程时,数组LINK 被释放,所以你丢失了你的数据。这不是您想要的,您最终会得到一个悬空指针 - 因此任何行为都是可能的,甚至包括看起来有效。您可以通过使用指针而不是可分配数组来避免这种情况。这在这里有效,因为指针在超出范围时不会自动释放,但这确实意味着内存泄漏和其他奇怪行为的可能性更大,所以通常你应该尝试在任何地方使用可分配数组而不是指针可能。
- 在 Fortran 中,指针的初始关联状态是未定义的,除非您对其进行初始化。由于未定义的指针可能导致奇怪的行为,最好使用
=> null() 显式初始化
事实上,一旦您修复了第 1 项,gfortran 至少可以告诉您,如果您打开所有警告标志,就会出现问题。下面包含此修复程序,以及您省略的打印例程。查看编译器产生的警告:
ijb@ianbushdesktop ~/work/stack $ cat link_alloc.f90
Module CLASS_LIST
Private
Type :: NODE
Real :: Value
Type(NODE), Pointer :: NEXT
End Type NODE
Type, Public :: LIST
Type(NODE), Pointer :: HEAD
Contains
Procedure :: APPEND
Procedure :: Print
End Type LIST
Contains
Subroutine APPEND(THIS, Value)
Class(LIST), Intent(INOUT) :: THIS
Real, Intent(IN) :: Value
Type(NODE), Allocatable, Target :: LINK
Allocate(LINK)
LINK%Value = Value
LINK%NEXT => THIS%HEAD
THIS%HEAD => LINK
End Subroutine APPEND
Subroutine Print( this )
Class( list ), Intent( In ) :: this
Call descend( this%head )
Contains
Recursive Subroutine descend( head )
Type( node ), Intent( In ) :: head
Write( *, '( f5.0, 1x )' ) head%value
If( Associated( head%next ) ) Then
Call descend( head%next )
End If
End Subroutine descend
End Subroutine Print
End Module CLASS_LIST
Program MAIN
Use CLASS_LIST
Type(LIST) :: A
Integer :: I
Do I = 1, 5, 1
Call A%APPEND(Real(I))
End Do
Call a%print
End Program MAIN
ijb@ianbushdesktop ~/work/stack $ gfortran -std=f2008 -Wall -Wextra -fcheck=all -O -g link_alloc.f90 -o link_alloc
link_alloc.f90:26:4:
THIS%HEAD => LINK
1
Warning: Pointer at (1) in pointer assignment might outlive the pointer target [-Wtarget-lifetime]
ijb@ianbushdesktop ~/work/stack $
英语有点神秘,但它真正告诉你的是上面的第 2 点——因为数组即将被释放,指针的寿命比它指向的要长。编译器警告非常有用,学习如何使用它们!同样,运行时检查 (-fcheck=all) 表明一切都被破坏了:
ijb@ianbushdesktop ~/work/stack $ ./link_alloc
0.
Program received signal SIGSEGV: Segmentation fault - invalid memory reference.
Backtrace for this error:
#0 0x7f470401f4af in ???
#1 0x7f4704ca3c49 in get_float_string
at ../../../gcc-7.4.0/libgfortran/io/write_float.def:1065
#2 0x7f4704ca4fe7 in write_float_0
at ../../../gcc-7.4.0/libgfortran/io/write.c:1597
#3 0x7f4704c9c9b4 in formatted_transfer_scalar_write
at ../../../gcc-7.4.0/libgfortran/io/transfer.c:2041
#4 0x7f4704c9cf4c in formatted_transfer
at ../../../gcc-7.4.0/libgfortran/io/transfer.c:2279
#5 0x40098a in descend
at /home/ijb/work/stack/link_alloc.f90:41
#6 0x4009a9 in descend
at /home/ijb/work/stack/link_alloc.f90:43
#7 0x4009d2 in __class_list_MOD_print
at /home/ijb/work/stack/link_alloc.f90:33
#8 0x400b1c in MAIN__
at /home/ijb/work/stack/link_alloc.f90:64
#9 0x400b1c in main
at /home/ijb/work/stack/link_alloc.f90:55
Segmentation fault
ijb@ianbushdesktop ~/work/stack $
通过使用新节点的指针来固定上面的第 2 点和第 3 点,并显式初始化指针,导致
ijb@ianbushdesktop ~/work/stack $ cat link_pointer.f90
Module CLASS_LIST
Private
Type :: NODE
Real :: Value
Type(NODE), Pointer :: NEXT => Null()
End Type NODE
Type, Public :: LIST
Type(NODE), Pointer :: HEAD => Null()
Contains
Procedure :: APPEND
Procedure :: Print
End Type LIST
Contains
Subroutine APPEND(THIS, Value)
Class(LIST), Intent(INOUT) :: THIS
Real, Intent(IN) :: Value
Type(NODE), Pointer :: LINK
Allocate(LINK)
LINK%Value = Value
LINK%NEXT => THIS%HEAD
THIS%HEAD => LINK
End Subroutine APPEND
Subroutine Print( this )
Class( list ), Intent( In ) :: this
Call descend( this%head )
Contains
Recursive Subroutine descend( head )
Type( node ), Intent( In ) :: head
Write( *, '( f5.0, 1x )' ) head%value
If( Associated( head%next ) ) Then
Call descend( head%next )
End If
End Subroutine descend
End Subroutine Print
End Module CLASS_LIST
Program MAIN
Use CLASS_LIST
Type(LIST) :: A
Integer :: I
Do I = 1, 5, 1
Call A%APPEND(Real(I))
End Do
Call a%print
End Program MAIN
这编译没有警告并且重复正确运行:
ijb@ianbushdesktop ~/work/stack $ gfortran -std=f2008 -Wall -Wextra -fcheck=all -O -g link_pointer.f90 -o link_pointer
ijb@ianbushdesktop ~/work/stack $ ./link_pointer
5.
4.
3.
2.
1.
ijb@ianbushdesktop ~/work/stack $ ./link_pointer
5.
4.
3.
2.
1.
ijb@ianbushdesktop ~/work/stack $ ./link_pointer
5.
4.
3.
2.
1.
ijb@ianbushdesktop ~/work/stack $ ./link_pointer
5.
4.
3.
2.
1.
ijb@ianbushdesktop ~/work/stack $ ./link_pointer
5.
4.
3.
2.
1.
ijb@ianbushdesktop ~/work/stack $ ./link_pointer
5.
4.
3.
2.
1.