我正在Fortran中测试ALLOCATE和DEALLOCATE。我建立了大量的链表,并在结束程序之前尝试重新分配它。
该代码在macOS上与gfortran一起运行。当代码尝试取消分配链表时,有些成功,有些失败。 在下面输出信息:
after call
T
T
1
F 100000
enter
T 1
2
F 100000
enter
T 1
3
F 100000
enter
T 1
4
F 100000
enter
T 1
5
F 100000
enter
T 1
6
F 100000
enter
T 1
7
F 100000
enter
T 1
8
F 100000
enter
T 1
9
F 100000
enter
T 1
10
F 100000
enter
out(8225,0x7fffa4e84380) malloc: *** error for object 0x7fcd38600002: pointer being freed was not allocated
*** set a breakpoint in malloc_error_break to debug
Program received signal SIGABRT: Process abort signal.
Backtrace for this error:
#0 0x1057561ac
#1 0x105755553
#2 0x7fff6caddf59
Abort trap: 6
module data_link
implicit none
type :: datalink_i
integer :: i
type(datalink_i), pointer :: next
type(datalink_i), pointer :: prev
endtype datalink_i
type :: datacell_i
type(datalink_i), pointer :: content
endtype datacell_i
contains
subroutine datalink_i_add(head,data,index)
type(datalink_i),intent(inout), pointer :: head
type(datalink_i), pointer :: ptr
integer,intent(in) :: data,index
if (index == 1) then
allocate(head)
nullify(head%prev)
nullify(head%next)
head%i = data
else
ptr => head
allocate(head%next)
head => head%next
head%prev => ptr
nullify(head%next)
head%i = data
endif
end subroutine datalink_i_add
subroutine datalink_i_nullify(head)
type(datalink_i), intent(inout),pointer ::head
type(datalink_i), pointer ::ptr
integer :: i
do
if (.not.associated(head%next)) exit
head => head%next
enddo
ptr => head
write(*,*) associated(head%next),head%i
do
if (.not.associated(head%prev)) then
write(*,*) associated(ptr),ptr%i
head%next => null()
exit
endif
if (ptr%i == 100000) then
write(*,*) 'enter'
endif
deallocate(head)
head => ptr%prev
ptr => ptr%prev
enddo
end subroutine datalink_i_nullify
end module data_link
subroutine pttr(ptr)
use data_link
type(datacell_i),intent(inout),dimension(:),allocatable :: ptr
integer :: i,j
integer, dimension(:),allocatable:: index
allocate(ptr(100))
allocate(index(100))
index = 1
do j=1,100
write(*,*)j
do i=1,100000
call datalink_i_add(ptr(j)%content,i,index(j))
if (index(j) == 1) then
index(j) =0
endif
enddo
enddo
end subroutine pttr
program c2115
use data_link
implicit none
interface
subroutine pttr(ptr)
use data_link
type(datacell_i),intent(inout),dimension(:),allocatable :: ptr
endsubroutine
endinterface
integer :: Allocate_status = 0
real, dimension(:), pointer :: x
real, dimension(10), target :: y
integer ,parameter :: sizef = 10000000
integer :: i ,j
type(datacell_i),dimension(:),allocatable:: ptr2
type(datalink_i),pointer :: ptr1
integer :: index =1
call pttr(ptr2)
read(*,*)
write(*,*) 'after call'
do i=1,100
write(*,*) i
call datalink_i_nullify(ptr2(i)%content)
enddo
write(*,*) associated(ptr2(1)%content),allocated(ptr2)
read(*,*)
end program
我希望链表可以在调用datalink_i_nullify之后重新分配内存。但是在此过程中,出现了错误。