I wrote a simple StringBuffer class but the program behaves strangely. Three scenarios: it runs well, it hangs, or it produces a compiler error.
module jstringbuffer
implicit none
private !# everything is private, except:
public StringBuffer
type :: String
character(len=:), allocatable :: s
end type String
type :: StringBuffer
integer, private :: size = 0 ! number of elems
integer, private :: capacity = 8 ! initial capacity
type(String), private, allocatable :: data(:)
contains
procedure :: append, number_of_elems, total_length, join
end type StringBuffer
contains
function total_length(self) result(result)
class(StringBuffer), intent(in) :: self
integer :: i, result
result = 0
do i = 1, self%size
result = result + len(self%data(i)%s)
end do
end function
function number_of_elems(self) result(result)
class(StringBuffer), intent(in) :: self
integer :: result
result = self%size
end function
subroutine append(self, value)
class(StringBuffer), intent(inout) :: self
character(len=*), intent(in) :: value
type(String), allocatable :: temp(:)
if (self%size == 0) then
allocate (self%data(self%capacity))
end if
self%size = self%size + 1
if (self%size > self%capacity) then
self%capacity = self%capacity * 2
allocate (temp(self%capacity))
temp(1:self%size - 1) = self%data(1:self%size - 1)
call move_alloc(temp, self%data)
end if
self%data(self%size) = String(value)
end subroutine
function join(self, sep) result(result)
class(StringBuffer), intent(in) :: self
character(len=*), intent(in) :: sep
character(len=:), allocatable :: result
integer :: i, j, length, extra, len_alloc
! print *, sep ! it hangs if the line "it's OK" is active
if (.not. allocated(self%data)) then
result = ""
else
extra = max(0, self%number_of_elems() - 1) * len(sep)
len_alloc = self%total_length() + extra
allocate (character(len=self%total_length() + extra) :: result) ! compiler error
! allocate (character(len=len_alloc) :: result) ! it's OK
j = 1
do i = 1, self%size
associate (s => self%data(i)%s)
if (i > 1) then
length = len(sep)
result(j:j + length - 1) = sep
j = j + length
end if
length = len(s)
result(j:j + length - 1) = s
j = j + length
end associate
end do
end if
end function
end module jstringbuffer
program alap
use jstringbuffer
implicit none
type(StringBuffer) :: sb
call sb%append("a")
call sb%append("ccc")
call sb%append("bb")
print '(*(g0))', "'", sb%join(", "), "'"
end program alap
I tried it under Manjaro Linux.
$ gfortran --version
GNU Fortran (GCC) 15.2.1 20251112
In its current form, it produces a compiler error:
$ gfortran compiler_error.f90
f951: internal compiler error: Segmentation fault
0x250b271 diagnostic_context::diagnostic_impl(rich_location*, diagnostic_metadata const*, diagnostic_option_id, char const*, __va_list_tag (*) [1], diagnostic_t)
???:0
0x250bab0 internal_error(char const*, ...)
???:0
0x72ea6f gfc_find_derived_vtab(gfc_symbol*)
???:0
0x785452 gfc_reduce_init_expr(gfc_expr*)
???:0
0x753b98 gfc_match_char_spec(gfc_typespec*)
???:0
0x7b3e85 gfc_match_type_spec(gfc_typespec*)
???:0
0x7b4032 gfc_match_allocate()
???:0
0x81841a gfc_parse_file()
???:0
Please submit a full bug report, with preprocessed source (by using -freport-bug).
Please include the complete backtrace with any bug report.
See <https://gitlab.archlinux.org/archlinux/packaging/packages/gcc/-/issues> for instructions.
If you put line 68 (with “! compiler error”) in comment and uncomment the next line (“! it’s OK”), then it works fine. Now, if you uncomment line 61 (“! it hangs…”), then the program hangs until stopped with Ctrl+C.
I don’t see what the problem is here. Thanks.