Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=:), | intent(in), | allocatable | :: | profile_name |
Name of profile |
|
character(len=:), | intent(in), | allocatable | :: | compiler_name |
Name of compiler |
|
type(toml_key), | intent(in), | allocatable | :: | key_list(:) |
List of keys in the table |
|
type(toml_table), | intent(in), | pointer | :: | table |
Table containing OS tables |
|
type(error_t), | intent(out), | allocatable | :: | error |
Error handling |
|
logical, | intent(in) | :: | os_valid |
Was called with valid operating system |
Type | Visibility | Attributes | Name | Initial | |||
---|---|---|---|---|---|---|---|
character(len=:), | public, | allocatable | :: | c_flags | |||
character(len=:), | public, | allocatable | :: | cxx_flags | |||
character(len=:), | public, | allocatable | :: | err_message | |||
character(len=:), | public, | allocatable | :: | file_flags | |||
type(toml_key), | public, | allocatable | :: | file_list(:) | |||
character(len=:), | public, | allocatable | :: | file_name | |||
type(toml_table), | public, | pointer | :: | files | |||
character(len=:), | public, | allocatable | :: | flags | |||
integer, | public | :: | ifile | ||||
integer, | public | :: | ikey | ||||
logical, | public | :: | is_valid | ||||
character(len=:), | public, | allocatable | :: | key_name | |||
character(len=:), | public, | allocatable | :: | link_time_flags | |||
integer, | public | :: | stat |
subroutine validate_profile_table(profile_name, compiler_name, key_list, table, error, os_valid)
!> Name of profile
character(len=:), allocatable, intent(in) :: profile_name
!> Name of compiler
character(len=:), allocatable, intent(in) :: compiler_name
!> List of keys in the table
type(toml_key), allocatable, intent(in) :: key_list(:)
!> Table containing OS tables
type(toml_table), pointer, intent(in) :: table
!> Error handling
type(error_t), allocatable, intent(out) :: error
!> Was called with valid operating system
logical, intent(in) :: os_valid
character(len=:), allocatable :: flags, c_flags, cxx_flags, link_time_flags, key_name, file_name, file_flags, err_message
type(toml_table), pointer :: files
type(toml_key), allocatable :: file_list(:)
integer :: ikey, ifile, stat
logical :: is_valid
if (size(key_list).ge.1) then
do ikey=1,size(key_list)
key_name = key_list(ikey)%key
if (key_name.eq.'flags') then
call get_value(table, 'flags', flags, stat=stat)
if (stat /= toml_stat%success) then
call syntax_error(error, "flags has to be a key-value pair")
return
end if
else if (key_name.eq.'c-flags') then
call get_value(table, 'c-flags', c_flags, stat=stat)
if (stat /= toml_stat%success) then
call syntax_error(error, "c-flags has to be a key-value pair")
return
end if
else if (key_name.eq.'cxx-flags') then
call get_value(table, 'cxx-flags', cxx_flags, stat=stat)
if (stat /= toml_stat%success) then
call syntax_error(error, "cxx-flags has to be a key-value pair")
return
end if
else if (key_name.eq.'link-time-flags') then
call get_value(table, 'link-time-flags', link_time_flags, stat=stat)
if (stat /= toml_stat%success) then
call syntax_error(error, "link-time-flags has to be a key-value pair")
return
end if
else if (key_name.eq.'files') then
call get_value(table, 'files', files, stat=stat)
if (stat /= toml_stat%success) then
call syntax_error(error, "files has to be a table")
return
end if
call files%get_keys(file_list)
do ifile=1,size(file_list)
file_name = file_list(ifile)%key
call get_value(files, file_name, file_flags, stat=stat)
if (stat /= toml_stat%success) then
call syntax_error(error, "file scope flags has to be a key-value pair")
return
end if
end do
else if (.not. os_valid) then
call validate_os_name(key_name, is_valid)
err_message = "Unexpected key " // key_name // " found in profile table "//profile_name//" "//compiler_name//"."
if (.not. is_valid) call syntax_error(error, err_message)
else
err_message = "Unexpected key " // key_name // " found in profile table "//profile_name//" "//compiler_name//"."
call syntax_error(error, err_message)
end if
end do
end if
if (allocated(error)) return
end subroutine validate_profile_table