У вас есть три проблемы, как предлагается в комментариях
- В Фортране селектор компонента структуры имеет значение
%, НЕ .. Таким образом, ваша программа содержит синтаксические ошибки - В Фортране, когда массив
allocatable выходит из области видимости, он автоматически освобождается, если только он не имеет атрибута save. Это хорошо, так как утечки памяти при использовании выделяемых массивов невозможны, но вам здесь больно, так как при выходе из процедуры добавления массив LINK освобождается, поэтому вы теряете свои данные. Это не то, что вы хотите, и в итоге вы получите висячий указатель - и поэтому возможно любое поведение, включая даже появление на работе. Вы можете избежать этого, используя указатель вместо размещаемого массива. Это работает здесь, так как указатели не автоматически освобождаются при выходе из области видимости, но это означает, что утечки памяти и другое странное поведение гораздо более вероятны, поэтому обычно вы должны стараться использовать размещаемые массивы, а не указатели везде, где это возможно . - В Фортране начальный статус ассоциации указателя не определен, если вы его не инициализируете. Так как неопределенные указатели могут привести к странному поведению, лучше инициализировать явно, используя
=> 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 $
Engli sh немного крипти c, но о чем он действительно говорит, это пункт 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.