https://gcc.gnu.org/bugzilla/show_bug.cgi?id=116668
--- Comment #2 from Jordan ---
(In reply to Andrew Pinski from comment #1)
> Can you provide the full source where the ICE happens including all module
> sources?
>
> Also since you got the gfortran from your distro you should read the
> internal compiler error message:
> See for instructions.
>
>
> And report this bug to them too.
This is going to be a bit lengthy, but of course I will. :)
Here are all the modules in this little ecosystem. Please keep in mind, this
version is very sloppy and has been fixed in more recent updates.
(The C code is last because it binds to it.)
FORTRAN CODE HERE:
module thread_filo_queue
use :: thread_types
use :: thread_mutex
use, intrinsic :: iso_c_binding
implicit none
private
public :: concurrent_linked_filo_queue
public :: queue_data
integer(c_int), parameter :: QUEUE_NONE = 0
integer(c_int), parameter :: QUEUE_I32 = 1
integer(c_int), parameter :: QUEUE_I64 = 2
integer(c_int), parameter :: QUEUE_F32 = 3
integer(c_int), parameter :: QUEUE_F64 = 4
integer(c_int), parameter :: QUEUE_BOOL = 5
integer(c_int), parameter :: QUEUE_STRING = 6
integer(c_int), parameter :: QUEUE_GENERIC = 7
type :: queue_data
!* Basic types.
integer(c_int), pointer :: i32 => null()
integer(c_int64_t), pointer :: i64 => null()
real(c_float), pointer :: f32 => null()
real(c_double), pointer :: f64 => null()
logical(c_bool), pointer :: bool => null()
!* String.
character(len = :, kind = c_char), pointer :: string => null()
!* Completely polymorphic.
class(*), pointer :: generic => null()
!* Designate the type of the element.
integer(c_int) :: type = QUEUE_NONE
end type queue_data
interface queue_data
module procedure :: queue_data_constructor
end interface queue_data
type :: queue_node
type(queue_node), pointer :: next => null()
type(queue_data), pointer :: data => null()
end type queue_node
type :: concurrent_linked_filo_queue
private
type(queue_node), pointer :: head => null()
type(queue_node), pointer :: tail => null()
type(mutex_rwlock), pointer :: mutex => null()
type(c_ptr) :: c_mutex_pointer = c_null_ptr
integer(c_int) :: items = 0
contains
procedure :: push => concurrent_linked_filo_queue_push
procedure :: pop => concurrent_linked_filo_queue_pop
procedure :: destroy => concurrent_linked_filo_queue_destroy
procedure :: is_empty => concurrent_linked_filo_queue_is_empty
procedure :: get_size => concurrent_linked_filo_queue_get_size
end type concurrent_linked_filo_queue
interface concurrent_linked_filo_queue
module procedure :: constructor_concurrent_linked_filo_queue
end interface concurrent_linked_filo_queue
contains
function constructor_concurrent_linked_filo_queue() result(new_queue)
implicit none
type(concurrent_linked_filo_queue) :: new_queue
new_queue%mutex => thread_create_mutex_pointer()
new_queue%c_mutex_pointer = c_loc(new_queue%mutex)
end function constructor_concurrent_linked_filo_queue
!* Push an element into the end of a queue.
subroutine concurrent_linked_filo_queue_push(this, generic_pointer)
implicit none
class(concurrent_linked_filo_queue), intent(inout) :: this
type(queue_data), intent(in), pointer :: generic_pointer
integer(c_int) :: status
type(queue_node), pointer :: new_node
status = thread_write_lock(this%c_mutex_pointer)
!! BEGIN SAFE OPERATION.
if (.not. associated(generic_pointer)) then
error stop "[Thread FILO Queue] Error: Received a null pointer."
end if
allocate(new_node)
new_node%data => generic_pointer
! If the head is null, this is the new head.
if (.not. associated(this%head)) then
this%head => new_node
end if
! If we have a tail, it now points to the new node.
! The new node then becomes the tail.
if (associated(this%tail)) then
this%tail%next => new_node
this%tail => new_node
else
! If we do not have a tail, the new node is now the tail.
this%tail => new_node
end if
this%items = this%items + 1
!! END SAFE OPERATION.
status = thread_unlock_lock(this%c_mutex_pointer)
end subroutine concurrent_linked_filo_queue_push
!* Pop the first element off the queue.
function concurrent_linked_filo_queue_pop(this, generic_pointer_option)
result(some)
implicit none
class(concurrent_linked_filo_queue), intent(inout) :: this
class(*), intent(inout), pointer :: generic_pointer_option
logical(c_bool) :: some
integer(c_int) :: status
type(queue_node), pointer :: next_pointer
status = thread_write_lock(this%c_mutex_pointer)
!! BEGIN SAFE OPERATION.
some = .false.
generic_pointer_option => null()
! If we have a head, the output will become the head data.
! The head will now be shifted forward, and the old head will be clean
