So, something had broke on my install of fpm-search so I cloned the fpm-search repo from urbanjost. When I build it everything builds fine up to fhast_data_container.f90. It happens at line 96 at 21% complete everytime.
The full output is
PS C:\Users\Peyton\Documents\fpm-search> fpm build --profile "Release"
os.c done.
config.f90 done.
download_helper.f90 done.
os.f90 done.
package_types.f90 done.
fhash_data_container.f90 failed.
[ 21%] Compiling...
build\dependencies\fhash\src\fhash_data_container.f90:96:6:
raw = data
1
Error: Assignment to an allocatable polymorphic variable at (1) is not yet supported compilation terminated due to -fmax-errors=1.
<ERROR> Compilation failed for object "build_dependencies_fhash_src_fhash_data_container.f90.o "
<ERROR> stopping due to failed compilation
STOP 1
The first time around I had tried to build fpm-search from the Syize/fpm-search fork. It had also given that error on the same file except it was a 4% completed. I tried to do some searching before coming here and thought it was maybe it was an outdated or broken install of GCC. I had installed GCC through MSYS2 and install MinGW. I had upgraded all the packages to make sure they were up to date and then double checked the version of my gfortran. My version is 6.3.0. I don’t really know if that is the most recent version though. Could anybody help me out or if someones had this problem before, what’s you do to fix it?
Edit: So I believe the problem arose from gfortran itself because it didn’t support the lastet version for fortran that was needed so after some looking around online and working with ChatGPT(I know, I’m sorry) I added this:
subroutine assign_scalar_data(container, value)
type(fhash_container_t), intent(inout) :: container
class(*), intent(in) :: value
if (allocated(container%scalar_data)) deallocate(container%scalar_data)
allocate(container%scalar_data, source = value)
end subroutine assign_scalar_data
changed this:
if (present(raw)) then
if (present(match)) match = .true.
allocate(raw, source = data)
end if
to fhash_data_container.f90 for the complete file to look like:
module fhash_data_container
use iso_fortran_env, only: sp => real32, dp => real64, int32, int64
implicit none
private
public fhash_container_t
public fhash_container
!> Generic container for scalar and 1D data
type fhash_container_t
class(*), allocatable :: scalar_data
class(*), pointer :: scalar_ptr => NULL()
contains
procedure :: allocated => fhash_container_allocated
procedure :: get => fhash_container_get_scalar
procedure :: get_ptr => fhash_container_get_scalar_ptr
end type fhash_container_t
!> Create a fhash_container object from a polymorphic value
interface fhash_container
module procedure fhash_container_scalar
end interface fhash_container
contains
!> Helper subroutine to assign scalar data
subroutine assign_scalar_data(container, value)
type(fhash_container_t), intent(inout) :: container
class(*), intent(in) :: value
if (allocated(container%scalar_data)) deallocate(container%scalar_data)
allocate(container%scalar_data, source = value)
end subroutine assign_scalar_data
!> Helper to initialise a polymorphic data container with scalar
function fhash_container_scalar(value, pointer) result(container)
class(*), intent(in), target :: value
logical, intent(in), optional :: pointer
type(fhash_container_t) :: container
if (present(pointer)) then
if (pointer) then
container%scalar_ptr => value
else
call assign_scalar_data(container, value)
end if
else
call assign_scalar_data(container, value)
end if
end function fhash_container_scalar
!> Helper to determine if container contains anything
function fhash_container_allocated(container) result(alloc)
class(fhash_container_t), intent(in) :: container
logical :: alloc
alloc = allocated(container%scalar_data) .OR. &
associated(container%scalar_ptr)
end function fhash_container_allocated
!> Helper to return container value as intrinsic type
subroutine fhash_container_get_scalar(container, i32, i64, r32, r64, char, bool, raw, match, type_string)
class(fhash_container_t), intent(in), target :: container
integer(int32), intent(out), optional :: i32
integer(int64), intent(out), optional :: i64
real(sp), intent(out), optional :: r32
real(dp), intent(out), optional :: r64
character(:), allocatable, intent(out), optional :: char
logical, intent(out), optional :: bool
class(*), allocatable, intent(out), optional :: raw
logical, intent(out), optional :: match
character(:), allocatable, intent(out), optional :: type_string
class(*), pointer :: data
if (present(match)) match = .false.
if (.not.container%allocated()) return
if (allocated(container%scalar_data)) then
data => container%scalar_data
else
data => container%scalar_ptr
end if
if (present(raw)) then
if (present(match)) match = .true.
allocate(raw, source = data)
end if
select type(d => data)
type is(integer(int32))
if (present(type_string)) type_string = 'integer32'
if (present(i32)) then
if (present(match)) match = .true.
i32 = d
return
end if
type is (integer(int64))
if (present(type_string)) type_string = 'integer64'
if (present(i64)) then
if (present(match)) match = .true.
i64 = d
return
end if
type is (real(sp))
if (present(type_string)) type_string = 'real32'
if (present(r32)) then
if (present(match)) match = .true.
r32 = d
return
end if
type is (real(dp))
if (present(type_string)) type_string = 'real64'
if (present(r64)) then
if (present(match)) match = .true.
r64 = d
return
end if
type is (character(*))
if (present(type_string)) type_string = 'character*'
if (present(char)) then
if (present(match)) match = .true.
char = d
return
end if
type is (logical)
if (present(type_string)) type_string = 'logical'
if (present(bool)) then
if (present(match)) match = .true.
bool = d
return
end if
class default
if (present(type_string)) type_string = 'unknown'
end select
end subroutine fhash_container_get_scalar
!> Helper to return pointer to container value as intrinsic type
subroutine fhash_container_get_scalar_ptr(container, i32, i64, r32, r64, char, bool, raw, match, type_string)
class(fhash_container_t), intent(in), target :: container
integer(int32), pointer, intent(out), optional :: i32
integer(int64), pointer, intent(out), optional :: i64
real(sp), pointer, intent(out), optional :: r32
real(dp), pointer, intent(out), optional :: r64
character(:), pointer, intent(out), optional :: char
logical, pointer, intent(out), optional :: bool
class(*), pointer, intent(out), optional :: raw
logical, intent(out), optional :: match
character(:), allocatable, intent(out), optional :: type_string
class(*), pointer :: data
if (present(match)) match = .false.
if (.not.container%allocated()) return
if (allocated(container%scalar_data)) then
data => container%scalar_data
else
data => container%scalar_ptr
end if
if (present(raw)) then
if (present(match)) match = .true.
raw => data
end if
select type(d => data)
type is(integer(int32))
if (present(i32)) then
if (present(match)) match = .true.
if (present(type_string)) type_string = 'integer32'
i32 => d
return
end if
type is (integer(int64))
if (present(i64)) then
if (present(match)) match = .true.
if (present(type_string)) type_string = 'integer64'
i64 => d
return
end if
type is (real(sp))
if (present(r32)) then
if (present(match)) match = .true.
if (present(type_string)) type_string = 'real32'
r32 => d
return
end if
type is (real(dp))
if (present(r64)) then
if (present(match)) match = .true.
if (present(type_string)) type_string = 'real64'
r64 => d
return
end if
type is (character(*))
if (present(char)) then
if (present(match)) match = .true.
if (present(type_string)) type_string = 'character*'
char => d
return
end if
type is (logical)
if (present(bool)) then
if (present(match)) match = .true.
if (present(type_string)) type_string = 'logical'
bool => d
return
end if
class default
if (present(type_string)) type_string = 'unknown'
end select
end subroutine fhash_container_get_scalar_ptr
end module fhash_data_container
and then fhash_sll.f90 was throwing up an error for the same thing and the refactored code is:
module fhash_sll
use iso_fortran_env, only: int32, int64
use fhash_key_base, only: fhash_key_t
use fhash_data_container, only: fhash_container_t
implicit none
!> Node type for hash table singly linked list
type fhash_node_t
class(fhash_key_t), allocatable :: key
type(fhash_container_t) :: value
type(fhash_node_t), pointer :: next => NULL()
end type fhash_node_t
contains
!> Append node to SLL
recursive subroutine sll_push_node(node, key, value, pointer)
!> Node to which to add data
type(fhash_node_t), intent(inout) :: node
!> Key to add
class(fhash_key_t), intent(in) :: key
!> Value to add
class(*), intent(in), target :: value
!> Store only a point if .true.
logical, intent(in), optional :: pointer
if (allocated(node%key)) then
if (node%key == key) then
call sll_node_set(node, value, pointer)
return
end if
if (.not.associated(node%next)) then
allocate(node%next)
end if
call sll_push_node(node%next, key, value, pointer)
else
allocate(node%key, source=key) ! Allocate key using source
call sll_node_set(node, value, pointer)
end if
end subroutine sll_push_node
!> Set container value in node
subroutine sll_node_set(node, value, pointer)
!> Node to which to add data
type(fhash_node_t), intent(inout) :: node
!> Value to set
class(*), intent(in), target :: value
!> Store only a pointer if .true.
logical, intent(in), optional :: pointer
if (present(pointer)) then
if (pointer) then
node%value%scalar_ptr => value
return
end if
end if
if (allocated(node%value%scalar_data)) deallocate(node%value%scalar_data)
allocate(node%value%scalar_data, source = value)
end subroutine sll_node_set
!> Search for a node with a specific key.
!> Returns a pointer to the 'data' component of the corresponding node.
!> Pointer is not associated if node cannot be found
recursive subroutine sll_find_in(node, key, data, found)
!> Node to search in
type(fhash_node_t), intent(in), target :: node
!> Key to look for
class(fhash_key_t) :: key
!> Pointer to value container if found.
!> (Unassociated if the key is not found in node)
type(fhash_container_t), pointer, intent(out) :: data
logical, intent(out), optional :: found
data => NULL()
if (present(found)) found = .false.
if (.not.allocated(node%key)) then
return
else if (node%key == key) then
if (present(found)) found = .true.
data => node%value
return
else if (associated(node%next)) then
call sll_find_in(node%next, key, data, found)
end if
end subroutine sll_find_in
!> Search for a node with a specific key and remove
recursive subroutine sll_remove(node, key, found, parent_node)
!> Node to remove from
type(fhash_node_t), intent(inout) :: node
!> Key to remove
class(fhash_key_t) :: key
!> Indicates if the key was found in node and removed
logical, optional, intent(out) :: found
!> Used internally
type(fhash_node_t), intent(inout), optional :: parent_node
type(fhash_node_t), pointer :: next_temp
if (present(found)) then
found = .false.
end if
if (.not.allocated(node%key)) then
return
else if (node%key == key) then
if (present(found)) then
found = .true.
end if
if (.not.present(parent_node)) then
! This is the top-level node
if (associated(node%next)) then
! Replace with next
next_temp => node%next
node = next_temp
deallocate(next_temp)
return
else
! No children, just deallocate
deallocate(node%key)
return
end if
else
! Not top-level node
if (associated(node%next)) then
! Join previous with next
next_temp => node%next
deallocate(parent_node%next)
parent_node%next => next_temp
return
else
! No children, just deallocate
deallocate(node%key)
deallocate(parent_node%next)
return
end if
end if
else if (associated(node%next)) then
! Look further down
call sll_remove(node%next, key, found, node)
end if
end subroutine sll_remove
!> Deallocate node components and those of its children
recursive subroutine sll_clean(node)
!> Node to search in
type(fhash_node_t), intent(inout) :: node
if (associated(node%next)) then
call sll_clean(node%next)
deallocate(node%next)
end if
end subroutine sll_clean
!> Determine depth of SLL
function node_depth(node) result(depth)
!> Node to check depth
type(fhash_node_t), intent(in), target :: node
integer :: depth
type(fhash_node_t), pointer :: current
if (.not.allocated(node%key)) then
depth = 0
return
else
depth = 1
current => node
do while(associated(current%next))
depth = depth + 1
current => current%next
end do
end if
end function node_depth
end module fhash_sll