Traverse compiler tables
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=:), | intent(in), | allocatable | :: | profile_name |
Name of profile |
|
type(toml_key), | intent(in), | allocatable | :: | comp_list(:) |
List of OSs in table with profile name given |
|
type(toml_table), | intent(in), | pointer | :: | table |
Table containing compiler tables |
|
type(error_t), | intent(out), | allocatable | :: | error |
Error handling |
|
integer, | intent(inout), | optional | :: | profiles_size |
Number of profiles in list of profiles |
|
type(profile_config_t), | intent(inout), | optional, | allocatable | :: | profiles(:) |
List of profiles |
integer, | intent(inout), | optional | :: | profindex |
Index in the list of profiles |
Type | Visibility | Attributes | Name | Initial | |||
---|---|---|---|---|---|---|---|
type(toml_table), | public, | pointer | :: | comp_node | |||
character(len=:), | public, | allocatable | :: | compiler_name | |||
integer, | public | :: | icomp | ||||
logical, | public | :: | is_valid | ||||
type(toml_key), | public, | allocatable | :: | os_list(:) | |||
integer, | public | :: | stat |
subroutine traverse_compilers(profile_name, comp_list, table, error, profiles_size, profiles, profindex)
!> Name of profile
character(len=:), allocatable, intent(in) :: profile_name
!> List of OSs in table with profile name given
type(toml_key), allocatable, intent(in) :: comp_list(:)
!> Table containing compiler tables
type(toml_table), pointer, intent(in) :: table
!> Error handling
type(error_t), allocatable, intent(out) :: error
!> Number of profiles in list of profiles
integer, intent(inout), optional :: profiles_size
!> List of profiles
type(profile_config_t), allocatable, intent(inout), optional :: profiles(:)
!> Index in the list of profiles
integer, intent(inout), optional :: profindex
character(len=:), allocatable :: compiler_name
type(toml_table), pointer :: comp_node
type(toml_key), allocatable :: os_list(:)
integer :: icomp, stat
logical :: is_valid
if (size(comp_list)<1) return
do icomp = 1, size(comp_list)
call validate_compiler_name(comp_list(icomp)%key, is_valid)
if (is_valid) then
compiler_name = comp_list(icomp)%key
call get_value(table, compiler_name, comp_node, stat=stat)
if (stat /= toml_stat%success) then
call syntax_error(error, "Compiler "//comp_list(icomp)%key//" must be a table entry")
exit
end if
call comp_node%get_keys(os_list)
if (present(profiles_size)) then
call traverse_oss_for_size(profile_name, compiler_name, os_list, comp_node, profiles_size, error)
if (allocated(error)) return
else
if (.not.(present(profiles).and.present(profindex))) then
call fatal_error(error, "Both profiles and profindex have to be present")
return
end if
call traverse_oss(profile_name, compiler_name, os_list, comp_node, &
& profiles, profindex, error)
if (allocated(error)) return
end if
else
call fatal_error(error,'*traverse_compilers*:Error: Compiler name not specified or invalid.')
end if
end do
end subroutine traverse_compilers