traverse_oss_for_size Subroutine

public subroutine traverse_oss_for_size(profile_name, compiler_name, os_list, table, profiles_size, error)

Traverse operating system tables to obtain number of profiles

Arguments

Type IntentOptional 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 :: os_list(:)

List of OSs in table with profile name and compiler name given
type(toml_table), intent(in), pointer :: table

Table containing OS tables
integer, intent(inout) :: profiles_size

Number of profiles in list of profiles
type(error_t), intent(out), allocatable :: error

Error handling

Variables

Type Visibility Attributes Name Initial
integer, public :: ios
logical, public :: is_key_val
logical, public :: is_valid
type(toml_key), public, allocatable :: key_list(:)
logical, public :: key_val_added
character(len=:), public, allocatable :: l_os_name
character(len=:), public, allocatable :: os_name
type(toml_table), public, pointer :: os_node
integer, public :: stat

Source Code

      subroutine traverse_oss_for_size(profile_name, compiler_name, os_list, table, profiles_size, error)

        !> Name of profile
        character(len=:), allocatable, intent(in) :: profile_name

        !> Name of compiler
        character(len=:), allocatable, intent(in) :: compiler_name

        !> List of OSs in table with profile name and compiler name given
        type(toml_key), allocatable, intent(in) :: os_list(:)

        !> Table containing OS 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) :: profiles_size

        type(toml_key), allocatable :: key_list(:)
        character(len=:), allocatable :: os_name, l_os_name
        type(toml_table), pointer :: os_node
        integer :: ios, stat
        logical :: is_valid, key_val_added, is_key_val

        if (size(os_list)<1) return
        key_val_added = .false.
        do ios = 1, size(os_list)
          os_name = os_list(ios)%key
          call validate_os_name(os_name, is_valid)
          if (is_valid) then
            call get_value(table, os_name, os_node, stat=stat)
            if (stat /= toml_stat%success) then
              call syntax_error(error, "os "//os_name//" has to be a table")
              return
            end if
            call os_node%get_keys(key_list)
            profiles_size = profiles_size + 1
            call validate_profile_table(profile_name, compiler_name, key_list, os_node, error, .true.)
          else
            ! Not lowercase OS name
            l_os_name = lower(os_name)
            call validate_os_name(l_os_name, is_valid)
            if (is_valid) then
              call fatal_error(error,'*traverse_oss*:Error: Name of the operating system must be a lowercase string.')
            end if
            if (allocated(error)) return

            ! Missing OS name
            is_key_val = .false.
            os_name = os_list(ios)%key
            call get_value(table, os_name, os_node, stat=stat)
            if (stat /= toml_stat%success) then
              is_key_val = .true.
            end if
            os_node=>table
            if (is_key_val.and..not.key_val_added) then
              key_val_added = .true.
              is_key_val = .false.
              profiles_size = profiles_size + 1
            else if (.not.is_key_val) then
              profiles_size = profiles_size + 1
            end if
            call validate_profile_table(profile_name, compiler_name, os_list, os_node, error, .false.)
          end if
        end do
      end subroutine traverse_oss_for_size