This function will parse and read the macros list and return them as defined flags. Set macro defintion symbol on the basis of compiler used Check if macros are not allocated. Split the macro name and value.
Check if the value of macro starts with ‘{‘ character.
Check if the value of macro ends with ‘}’ character.
Check if the string contains “version” as substring.
These conditions are placed in order to ensure proper spacing between the macros.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer(kind=compiler_enum), | intent(in) | :: | id | |||
type(string_t), | intent(in), | allocatable | :: | macros_list(:) | ||
character(len=:), | intent(in), | allocatable | :: | version |
Type | Visibility | Attributes | Name | Initial | |||
---|---|---|---|---|---|---|---|
integer, | public | :: | i | ||||
character(len=:), | public, | allocatable | :: | macro_definition_symbol | |||
character(len=:), | public, | allocatable | :: | valued_macros(:) |
function get_macros(id, macros_list, version) result(macros)
integer(compiler_enum), intent(in) :: id
character(len=:), allocatable, intent(in) :: version
type(string_t), allocatable, intent(in) :: macros_list(:)
character(len=:), allocatable :: macros
character(len=:), allocatable :: macro_definition_symbol
character(:), allocatable :: valued_macros(:)
integer :: i
if (.not.allocated(macros_list)) then
macros = ""
return
end if
!> Set macro defintion symbol on the basis of compiler used
select case(id)
case default
macro_definition_symbol = " -D"
case (id_intel_classic_windows, id_intel_llvm_windows)
macro_definition_symbol = " /D"
end select
!> Check if macros are not allocated.
if (.not.allocated(macros)) then
macros=""
end if
do i = 1, size(macros_list)
!> Split the macro name and value.
call split(macros_list(i)%s, valued_macros, delimiters="=")
if (size(valued_macros) > 1) then
!> Check if the value of macro starts with '{' character.
if (str_begins_with_str(trim(valued_macros(size(valued_macros))), "{")) then
!> Check if the value of macro ends with '}' character.
if (str_ends_with(trim(valued_macros(size(valued_macros))), "}")) then
!> Check if the string contains "version" as substring.
if (index(valued_macros(size(valued_macros)), "version") /= 0) then
!> These conditions are placed in order to ensure proper spacing between the macros.
macros = macros//macro_definition_symbol//trim(valued_macros(1))//'='//version
cycle
end if
end if
end if
end if
macros = macros//macro_definition_symbol//macros_list(i)%s
end do
end function get_macros