llvm / llvm/llvm-project

[flang] Crash (Aborted, core dumped) when compiling derived type with recursive allocatable component and final procedure

Open
#203,889 2 comments 0 reactions 1 assignee Claimed by @eugeneepshteyn View on GitHub
crash flang:frontend
Dominant language
LLVM
Stars
40.5k
Forks
18.7k
PR merge metrics
PR metrics pending

Description

## 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

Image

```fortran
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
```

Contributor guide

Open the contributing guide

Assessment

This issue has not been assessed yet.

Get new issues in your inbox

A short digest of beginner-friendly GitHub issues.