| Issue |
203889
|
| Summary |
[flang] Crash (Aborted, core dumped) when compiling derived type with recursive allocatable component and final procedure
|
| Labels |
flang
|
| Assignees |
|
| Reporter |
RinswindtheMage
|
## Description
flang 22.1.1 crashes with "Aborted (core dumped)" during compilation
of a Fortran module containing a recursive derived type with an
allocatable component of the same type, a `final` procedure, and
`move_alloc` operations on that component.
## Environment
- flang version: 22.1.1
- Target: x86_64-linux-gnu
## Steps to reproduce
1. Save the attached `IO.f90` and `environment.f90`
2. Run: flang -ffree-line-length-none -c IO.f90
## Expected behavior
Compiler should either compile successfully or report a normal
diagnostic error.
## Actual behavior
Compiler crashes with:
## Attached files
- main-183aa5 (preprocessed source, as requested by flang)
- main-183aa5.sh (repro script)
- IO.f90
<img width="794" height="535" alt="Image" src="" />
module Environment
use ISO_Fortran_Env
implicit none
integer, parameter :: I_ = INT32
integer, parameter :: R_ = REAL32
integer, parameter :: C_ = R_
integer, parameter :: CH_= Selected_Char_Kind("ISO_10646")
character(*), parameter :: E_ = "UTF-8"
integer(I_), parameter :: SURNAME_LEN = 15 ! не используется, оставлено для совместимости
integer(I_), parameter :: POS_LEN = 20
interface operator (//)
module procedure Int_plus_string
module procedure String_plus_int
end interface
contains
pure function Int_plus_string(n, str) result(res)
integer, intent(in) :: n
character(*), intent(in) :: str
character(len(str) + max(floor(log10(real(n, kind=I_*2))) + 1, 1)) :: res
write (res, '(i0, a)') n, str
end function Int_plus_string
pure function String_plus_int(str, n) result(res)
character(*), intent(in) :: str
integer, intent(in) :: n
character(len(str) + max(floor(log10(real(n, kind=I_*2))) + 1, 1)) :: res
write (res, '(a, i0)') str, n
end function String_plus_int
subroutine Handle_IO_status(IO, where)
integer, intent(in) :: IO
character(*), intent(in) :: where
open (ERROR_UNIT, encoding=E_)
select case(IO)
case(0, IOSTAT_END, IOSTAT_EOR)
case(1:)
write (ERROR_UNIT, '(a, i0)') "Error " // where // ": ", IO
case default
write (ERROR_UNIT, '(a, i0)') "Undetermined behaviour while " // where // ": ", IO
end select
end subroutine Handle_IO_status
end module Environment
module IO
use Environment
implicit none
private
public :: List
type :: ListNode
character(len=:, kind=CH_), allocatable :: line
type(ListNode), allocatable :: next
end type ListNode
type :: List
type(ListNode), allocatable :: head
integer(I_) :: length = 0
contains
procedure :: ReadFromFile
procedure :: WriteToFile
procedure :: Exclude
procedure :: Destroy
final :: Finalize_list
end type List
contains
! ------------------------------------------------------------
! Чтение из файла (каждая строка – элемент списка)
subroutine ReadFromFile(this, filename)
class(List), intent(inout) :: this
character(*), intent(in) :: filename
integer(I_) :: In
character(len=1024, kind=CH_) :: buffer
open(file=filename, encoding=E_, newunit=In)
if (allocated(this%head)) call this%Destroy()
call Read_line(In, this%head, this%length, buffer)
close(In)
contains
! Хвостовая рекурсия: вызов Read_line – последнее действие
recursive subroutine Read_line(In_unit, node, length, buffer)
integer(I_), intent(in) :: In_unit
type(ListNode), allocatable, intent(out) :: node
integer(I_), intent(inout) :: length
character(len=1024, kind=CH_), intent(inout) :: buffer
integer(I_) :: IO_stat
read(In_unit, '(A)', iostat=IO_stat) buffer
if (IO_stat == 0) then
allocate(node)
node%line = trim(buffer)
length = length + 1
call Read_line(In_unit, node%next, length, buffer) ! хвостовой вызов
else
call Handle_IO_status(IO_stat, "reading line")
end if
end subroutine Read_line
end subroutine ReadFromFile
! ------------------------------------------------------------
! Запись списка в файл
subroutine WriteToFile(this, filename, position, title)
class(List), intent(in) :: this
character(*), intent(in) :: filename, position
character(*, kind=CH_), intent(in) :: title
integer(I_) :: Out
open(file=filename, encoding=E_, position=position, newunit=Out)
write(Out, '(/A)') title
call Write_line(Out, this%head)
close(Out)
contains
! Хвостовая рекурсия, целостность списка гарантируется (intent in)
recursive subroutine Write_line(Out_unit, node)
integer, intent(in) :: Out_unit
type(ListNode), allocatable, intent(in) :: node
if (allocated(node)) then
write(Out_unit, '(A)') node%line
call Write_line(Out_unit, node%next) ! хвостовой вызов
end if
end subroutine Write_line
end subroutine WriteToFile
! ------------------------------------------------------------
! Чистая хвостовая рекурсивная функция: присутствует ли строка `line`
! в списке, начинающемся с узла `node`
pure recursive function Is_present(line, node) result(found)
character(*, kind=CH_), intent(in) :: line
type(ListNode), allocatable, intent(in) :: node
logical :: found
if (.not. allocated(node)) then
found = .false.
else if (node%line == line) then
found = .true.
else
found = Is_present(line, node%next) ! хвостовой вызов
end if
end function Is_present
! ------------------------------------------------------------
! Удаление из текущего списка всех строк, которые есть в списке `other`
subroutine Exclude(this, other)
class(List), intent(inout) :: this
class(List), intent(in) :: other
if (.not. allocated(this%head)) return
if (other%length == 0) return
call Delete_matching(this%head, other%head, this%length)
contains
! Хвостовая рекурсия по списку this; other передаётся как intent(in)
! и не изменяется (гарантия целостности фильтрующего списка).
recursive subroutine Delete_matching(node, other_head, length)
type(ListNode), allocatable, intent(inout) :: node
type(ListNode), allocatable, intent(in) :: other_head
integer(I_), intent(inout) :: length
type(ListNode), allocatable :: tail
if (.not. allocated(node)) return
if (Is_present(node%line, other_head)) then
! Забираем хвост узла, удаляем сам узел, ставим хвост на его место
call move_alloc(node%next, tail)
deallocate(node)
call move_alloc(tail, node)
length = length - 1
call Delete_matching(node, other_head, length) ! хвостовой вызов
else
call Delete_matching(node%next, other_head, length) ! хвостовой вызов
end if
end subroutine Delete_matching
end subroutine Exclude
! ------------------------------------------------------------
! Уничтожение списка (хвостовая рекурсия через вложенную процедуру)
subroutine Destroy(this)
class(List), intent(inout) :: this
call Destroy_node(this%head)
this%length = 0
end subroutine Destroy
! Хвостовая рекурсия: освобождает узлы один за другим
recursive subroutine Destroy_node(node)
type(ListNode), allocatable, intent(inout) :: node
type(ListNode), allocatable :: tail
if (.not. allocated(node)) return
call move_alloc(node%next, tail)
deallocate(node)
call Destroy_node(tail) ! хвостовой вызов
end subroutine Destroy_node
! ------------------------------------------------------------
! Завершаемая процедура (final): гарантирует освобождение списка
! при выходе из области видимости объекта типа List
recursive subroutine Finalize_list(this)
type(List), intent(inout) :: this
call Destroy_node(this%head)
this%length = 0
end subroutine Finalize_list
end module IO
program lab3_variant13
use Environment
use IO
implicit none
character(*), parameter :: input_file = "../data/input.txt" ! исходные строки
character(*), parameter :: delete_file = "../data/delete.txt" ! строки для удаления
character(*), parameter :: output_file = "output.txt"
type(List) :: S, D
! 1. Формирование односвязного списка S из файла In
call S%ReadFromFile(input_file)
! 2. Формирование списка D из файла Delete
call D%ReadFromFile(delete_file)
! 3. Исключение из списка S элементов, присутствующих в D
call S%Exclude(D)
! 4. Вывод результата в выходной файл
call S%WriteToFile(output_file, "rewind", CH_"Результат после удаления:")
! 5. Уничтожение списков
call S%Destroy()
call D%Destroy()
end program lab3_variant13
ERROR
# Crash reproducer for clang version 22.1.1 (https://github.com/llvm/llvm-project.git fef02d48c08db859ef83f84232ed78bd9d1c323a)
# Driver args: "-std=f2018" "-fimplicit-none" "-Jobj/" "-module-dir" "obj/" "-O0" "-c" "src/main.f90" "-o" "obj/main.o"
# Original command: "/usr/local/bin/flang" "-fc1" "-triple" "x86_64-unknown-linux-gnu" "-emit-obj" "-fimplicit-none" "-mrelocation-model" "pic" "-pic-level" "2" "-pic-is-pie" "-target-cpu" "x86-64" "-std=f2018" "-module-dir" "obj/" "-module-dir" "obj/" "-resource-dir" "/usr/local/lib/clang/22" "-mframe-pointer=all" "-O0" "-o" "obj/main.o" "-x" "f95" "src/main.f90"
"/usr/local/bin/flang" "-fc1" "-triple" "x86_64-unknown-linux-gnu" "-emit-obj" "-fimplicit-none" "-mrelocation-model" "pic" "-pic-level" "2" "-pic-is-pie" "-target-cpu" "x86-64" "-std=f2018" "-module-dir" "obj/" "-module-dir" "obj/" "-mframe-pointer=all" "-O0" "-x" "f95" "main-183aa5"
----------------------------------------
#line "./src/main.f90" 1
program lab3_variant13
use Environment
use IO
implicit none
character(*), parameter :: input_file = "../data/input.txt"
character(*), parameter :: delete_file = "../data/delete.txt"
character(*), parameter :: output_file = "output.txt"
type(List) :: S, D
call S%ReadFromFile(input_file)
call D%ReadFromFile(delete_file)
call S%Exclude(D)
call S%WriteToFile(output_file, "rewind", CH_"Результат �&
&�осле удаления:")
call S%Destroy()
call D%Destroy()
end program lab3_variant13
![]()
_______________________________________________
llvm-bugs mailing list
[email protected]
https://lists.llvm.org/cgi-bin/mailman/listinfo/llvm-bugs
