profiles.f90 Source File


Source Code

!> Implementation of the meta data for compiler flag profiles.
!>
!> A profiles table can currently have the following subtables:
!> Profile names - any string, if omitted, flags are appended to all matching profiles
!> Compiler - any from the following list, omitting it yields an error
!>
!> - "gfortran"
!> - "ifort"
!> - "ifx"
!> - "pgfortran"
!> - "nvfortran"
!> - "flang"
!> - "caf"
!> - "f95"
!> - "lfortran"
!> - "lfc"
!> - "nagfor"
!> - "crayftn"
!> - "xlf90"
!> - "ftn95"
!>
!> OS - any from the following list, if omitted, the profile is used if and only
!> if there is no profile perfectly matching the current configuration
!>
!> - "linux"
!> - "macos"
!> - "windows"
!> - "cygwin"
!> - "solaris"
!> - "freebsd"
!> - "openbsd"
!> - "unknown"
!>
!> Each of the subtables currently supports the following fields:
!>```toml
!>[profiles.debug.gfortran.linux]
!> flags="-Wall -g -Og"
!> c-flags="-g O1"
!> cxx-flags="-g O1"
!> link-time-flags="-xlinkopt"
!> files={"hello_world.f90"="-Wall -O3"}
!>```
!>
module fpm_manifest_profile
    use fpm_error, only : error_t, syntax_error, fatal_error, fpm_stop
    use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, serializable_t, set_value, &
                         set_string, add_table
    use fpm_strings, only: lower
    use fpm_environment, only: get_os_type, OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, &
                             OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD, OS_NAME
    use fpm_filesystem, only: join_path
    implicit none
    public :: profile_config_t, new_profile, new_profiles, get_default_profiles, &
            & info_profile, find_profile, DEFAULT_COMPILER

    !> Name of the default compiler
    character(len=*), parameter :: DEFAULT_COMPILER = 'gfortran'
    integer, parameter :: OS_ALL = -1
    character(len=:), allocatable :: path

    !> Type storing file name - file scope compiler flags pairs
    type, extends(serializable_t) :: file_scope_flag

      !> Name of the file
      character(len=:), allocatable :: file_name

      !> File scope flags
      character(len=:), allocatable :: flags

      contains

          !> Serialization interface
          procedure :: serializable_is_same => file_scope_same
          procedure :: dump_to_toml => file_scope_dump
          procedure :: load_from_toml => file_scope_load

    end type file_scope_flag

    !> Configuration meta data for a profile
    type, extends(serializable_t) :: profile_config_t
      !> Name of the profile
      character(len=:), allocatable :: profile_name

      !> Name of the compiler
      character(len=:), allocatable :: compiler

      !> Value repesenting OS
      integer :: os_type = OS_ALL

      !> Fortran compiler flags
      character(len=:), allocatable :: flags

      !> C compiler flags
      character(len=:), allocatable :: c_flags

      !> C++ compiler flags
      character(len=:), allocatable :: cxx_flags

      !> Link time compiler flags
      character(len=:), allocatable :: link_time_flags

      !> File scope flags
      type(file_scope_flag), allocatable :: file_scope_flags(:)

      !> Is this profile one of the built-in ones?
      logical :: is_built_in = .false.

      contains

        !> Print information on this instance
        procedure :: info

        !> Serialization interface
        procedure :: serializable_is_same => profile_same
        procedure :: dump_to_toml => profile_dump
        procedure :: load_from_toml => profile_load

    end type profile_config_t

    contains

      !> Construct a new profile configuration from a TOML data structure
      function new_profile(profile_name, compiler, os_type, flags, c_flags, cxx_flags, &
                           link_time_flags, file_scope_flags, is_built_in) &
                      & result(profile)

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

        !> Name of the compiler
        character(len=*), intent(in) :: compiler

        !> Type of the OS
        integer, intent(in) :: os_type

        !> Fortran compiler flags
        character(len=*), optional, intent(in) :: flags

        !> C compiler flags
        character(len=*), optional, intent(in) :: c_flags

        !> C++ compiler flags
        character(len=*), optional, intent(in) :: cxx_flags

        !> Link time compiler flags
        character(len=*), optional, intent(in) :: link_time_flags

        !> File scope flags
        type(file_scope_flag), optional, intent(in) :: file_scope_flags(:)

        !> Is this profile one of the built-in ones?
        logical, optional, intent(in) :: is_built_in

        type(profile_config_t) :: profile

        profile%profile_name = profile_name
        profile%compiler = compiler
        profile%os_type = os_type
        if (present(flags)) then
          profile%flags = flags
        else
          profile%flags = ""
        end if
        if (present(c_flags)) then
          profile%c_flags = c_flags
        else
          profile%c_flags = ""
        end if
        if (present(cxx_flags)) then
          profile%cxx_flags = cxx_flags
        else
          profile%cxx_flags = ""
        end if
        if (present(link_time_flags)) then
          profile%link_time_flags = link_time_flags
        else
          profile%link_time_flags = ""
        end if
        if (present(file_scope_flags)) then
           profile%file_scope_flags = file_scope_flags
        end if
        if (present(is_built_in)) then
           profile%is_built_in = is_built_in
        else
           profile%is_built_in = .false.
        end if

      end function new_profile

      !> Check if compiler name is a valid compiler name
      subroutine validate_compiler_name(compiler_name, is_valid)

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

        !> Boolean value of whether compiler_name is valid or not
        logical, intent(out) :: is_valid
        select case(compiler_name)
          case("gfortran", "ifort", "ifx", "pgfortran", "nvfortran", "flang", "caf", &
                        & "f95", "lfortran", "lfc", "nagfor", "crayftn", "xlf90", "ftn95")
            is_valid = .true.
          case default
            is_valid = .false.
        end select
      end subroutine validate_compiler_name

      !> Check if os_name is a valid name of a supported OS
      subroutine validate_os_name(os_name, is_valid)

        !> Name of an operating system
        character(len=:), allocatable, intent(in) :: os_name

        !> Boolean value of whether os_name is valid or not
        logical, intent(out) :: is_valid

        select case (os_name)
          case ("linux", "macos", "windows", "cygwin", "solaris", "freebsd", &
                          & "openbsd", "unknown")
            is_valid = .true.
          case default
            is_valid = .false.
        end select

      end subroutine validate_os_name

      !> Match os_type enum to a lowercase string with name of OS
      subroutine match_os_type(os_name, os_type)

        !> Name of operating system
        character(len=:), allocatable, intent(in) :: os_name

        !> Enum representing type of OS
        integer, intent(out) :: os_type

        select case (os_name)
          case ("linux");   os_type = OS_LINUX
          case ("macos");   os_type = OS_MACOS
          case ("windows"); os_type = OS_WINDOWS
          case ("cygwin");  os_type = OS_CYGWIN
          case ("solaris"); os_type = OS_SOLARIS
          case ("freebsd"); os_type = OS_FREEBSD
          case ("openbsd"); os_type = OS_OPENBSD
          case ("all");     os_type = OS_ALL
          case default;     os_type = OS_UNKNOWN
        end select

      end subroutine match_os_type

      !> Match lowercase string with name of OS to os_type enum
      function os_type_name(os_type)

        !> Name of operating system
        character(len=:), allocatable :: os_type_name

        !> Enum representing type of OS
        integer, intent(in) :: os_type

        select case (os_type)
          case (OS_ALL); os_type_name = "all"
          case default; os_type_name = lower(OS_NAME(os_type))
        end select

      end function os_type_name

      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

      !> Look for flags, c-flags, link-time-flags key-val pairs
      !> and files table in a given table and create new profiles
      subroutine get_flags(profile_name, compiler_name, os_type, key_list, table, profiles, profindex, os_valid)

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

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

        !> OS type
        integer, intent(in) :: os_type

        !> 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

        !> List of profiles
        type(profile_config_t), allocatable, intent(inout) :: profiles(:)

        !> Index in the list of profiles
        integer, intent(inout) :: profindex

        !> 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(:)
        type(file_scope_flag), allocatable :: file_scope_flags(:)
        integer :: ikey, ifile, stat
        logical :: is_valid

        call get_value(table, 'flags', flags)
        call get_value(table, 'c-flags', c_flags)
        call get_value(table, 'cxx-flags', cxx_flags)
        call get_value(table, 'link-time-flags', link_time_flags)
        call get_value(table, 'files', files)
        if (associated(files)) then
          call files%get_keys(file_list)
          allocate(file_scope_flags(size(file_list)))
          do ifile=1,size(file_list)
            file_name = file_list(ifile)%key
            call get_value(files, file_name, file_flags)
            associate(cur_file=>file_scope_flags(ifile))
              if (.not.(path.eq."")) file_name = join_path(path, file_name)
              cur_file%file_name = file_name
              cur_file%flags = file_flags
            end associate
          end do
        end if

        profiles(profindex) = new_profile(profile_name, compiler_name, os_type, &
                 & flags, c_flags, cxx_flags, link_time_flags, file_scope_flags)
        profindex = profindex + 1
      end subroutine get_flags

      !> Traverse operating system tables to obtain number of profiles
      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


      !> Traverse operating system tables to obtain profiles
      subroutine traverse_oss(profile_name, compiler_name, os_list, table, profiles, profindex, 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

        !> List of profiles
        type(profile_config_t), allocatable, intent(inout) :: profiles(:)

        !> Index in the list of profiles
        integer, intent(inout) :: profindex

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

        if (size(os_list)<1) return
        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)
            call match_os_type(os_name, os_type)
            call get_flags(profile_name, compiler_name, os_type, key_list, os_node, profiles, profindex, .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
            os_type = OS_ALL
            call get_flags(profile_name, compiler_name, os_type, os_list, os_node, profiles, profindex, .false.)
          end if
        end do
      end subroutine traverse_oss

      !> Traverse compiler tables
      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

      !> Construct new profiles array from a TOML data structure
      subroutine new_profiles(profiles, table, error)

        !> Instance of the dependency configuration
        type(profile_config_t), allocatable, intent(out) :: profiles(:)

        !> Instance of the TOML data structure
        type(toml_table), target, intent(inout) :: table

        !> Error handling
        type(error_t), allocatable, intent(out) :: error

        type(toml_table), pointer :: prof_node
        type(toml_key), allocatable :: prof_list(:)
        type(toml_key), allocatable :: comp_list(:)
        type(toml_key), allocatable :: os_list(:)
        character(len=:), allocatable :: profile_name, compiler_name
        integer :: profiles_size, iprof, stat, profindex
        logical :: is_valid
        type(profile_config_t), allocatable :: default_profiles(:)

        path = ''

        default_profiles = get_default_profiles(error)
        if (allocated(error)) return
        call table%get_keys(prof_list)

        if (size(prof_list) < 1) return

        profiles_size = 0

        do iprof = 1, size(prof_list)
          profile_name = prof_list(iprof)%key
          call validate_compiler_name(profile_name, is_valid)
          if (is_valid) then
            profile_name = "all"
            comp_list = prof_list(iprof:iprof)
            prof_node=>table
            call traverse_compilers(profile_name, comp_list, prof_node, error, profiles_size=profiles_size)
            if (allocated(error)) return
          else
            call validate_os_name(profile_name, is_valid)
            if (is_valid) then
              os_list = prof_list(iprof:iprof)
              profile_name = 'all'
              compiler_name = DEFAULT_COMPILER
              call traverse_oss_for_size(profile_name, compiler_name, os_list, table, profiles_size, error)
              if (allocated(error)) return
            else
              call get_value(table, profile_name, prof_node, stat=stat)
              if (stat /= toml_stat%success) then
                call syntax_error(error, "Profile "//prof_list(iprof)%key//" must be a table entry")
                exit
              end if
              call prof_node%get_keys(comp_list)
              call traverse_compilers(profile_name, comp_list, prof_node, error, profiles_size=profiles_size)
              if (allocated(error)) return
            end if
          end if
        end do

        profiles_size = profiles_size + size(default_profiles)
        allocate(profiles(profiles_size))

        do profindex=1, size(default_profiles)
          profiles(profindex) = default_profiles(profindex)
        end do

        do iprof = 1, size(prof_list)
          profile_name = prof_list(iprof)%key
          call validate_compiler_name(profile_name, is_valid)
          if (is_valid) then
            profile_name = "all"
            comp_list = prof_list(iprof:iprof)
            prof_node=>table
            call traverse_compilers(profile_name, comp_list, prof_node, error, profiles=profiles, profindex=profindex)
            if (allocated(error)) return
          else
            call validate_os_name(profile_name, is_valid)
            if (is_valid) then
              os_list = prof_list(iprof:iprof)
              profile_name = 'all'
              compiler_name = DEFAULT_COMPILER
              prof_node=>table
              call traverse_oss(profile_name, compiler_name, os_list, prof_node, profiles, profindex, error)
              if (allocated(error)) return
            else
              call get_value(table, profile_name, prof_node, stat=stat)
              call prof_node%get_keys(comp_list)
              call traverse_compilers(profile_name, comp_list, prof_node, error, profiles=profiles, profindex=profindex)
              if (allocated(error)) return
            end if
          end if
        end do

        ! Apply profiles with profile name 'all' to matching profiles
        do iprof = 1,size(profiles)
          if (profiles(iprof)%profile_name.eq.'all') then
            do profindex = 1,size(profiles)
              if (.not.(profiles(profindex)%profile_name.eq.'all') &
                      & .and.(profiles(profindex)%compiler.eq.profiles(iprof)%compiler) &
                      & .and.(profiles(profindex)%os_type.eq.profiles(iprof)%os_type)) then
                profiles(profindex)%flags=profiles(profindex)%flags// &
                        & " "//profiles(iprof)%flags
                profiles(profindex)%c_flags=profiles(profindex)%c_flags// &
                        & " "//profiles(iprof)%c_flags
                profiles(profindex)%cxx_flags=profiles(profindex)%cxx_flags// &
                        & " "//profiles(iprof)%cxx_flags
                profiles(profindex)%link_time_flags=profiles(profindex)%link_time_flags// &
                        & " "//profiles(iprof)%link_time_flags
              end if
            end do
          end if
        end do
      end subroutine new_profiles

      !> Construct an array of built-in profiles
      function get_default_profiles(error) result(default_profiles)

        !> Error handling
        type(error_t), allocatable, intent(out) :: error

        type(profile_config_t), allocatable :: default_profiles(:)

        default_profiles = [ &
              & new_profile('release', &
                & 'caf', &
                & OS_ALL, &
                & flags=' -O3 -Wimplicit-interface -fPIC -fmax-errors=1 -funroll-loops', &
                & is_built_in=.true.), &
              & new_profile('release', &
                & 'gfortran', &
                & OS_ALL, &
                & flags=' -O3 -Wimplicit-interface -fPIC -fmax-errors=1 -funroll-loops -fcoarray=single', &
                & is_built_in=.true.), &
              & new_profile('release', &
                & 'f95', &
                & OS_ALL, &
                & flags=' -O3 -Wimplicit-interface -fPIC -fmax-errors=1 -ffast-math -funroll-loops', &
                & is_built_in=.true.), &
              & new_profile('release', &
                & 'nvfortran', &
                & OS_ALL, &
                & flags = ' -Mbackslash', &
                & is_built_in=.true.), &
              & new_profile('release', &
                & 'ifort', &
                & OS_ALL, &
                & flags = ' -fp-model precise -pc64 -align all -error-limit 1 -reentrancy&
                          & threaded -nogen-interfaces -assume byterecl', &
                & is_built_in=.true.), &
              & new_profile('release', &
                & 'ifort', &
                & OS_WINDOWS, &
                & flags = ' /fp:precise /align:all /error-limit:1 /reentrancy:threaded&
                          & /nogen-interfaces /assume:byterecl', &
                & is_built_in=.true.), &
              & new_profile('release', &
                & 'ifx', &
                & OS_ALL, &
                & flags = ' -fp-model=precise -pc64 -align all -error-limit 1 -reentrancy&
                          & threaded -nogen-interfaces -assume byterecl', &
                & is_built_in=.true.), &
              & new_profile('release', &
                & 'ifx', &
                & OS_WINDOWS, &
                & flags = ' /fp:precise /align:all /error-limit:1 /reentrancy:threaded&
                          & /nogen-interfaces /assume:byterecl', &
                & is_built_in=.true.), &
              & new_profile('release', &
                &'nagfor', &
                & OS_ALL, &
                & flags = ' -O4 -coarray=single -PIC', &
                & is_built_in=.true.), &
              & new_profile('release', &
                &'lfortran', &
                & OS_ALL, &
                & flags = ' flag_lfortran_opt', &
                & is_built_in=.true.), &
              & new_profile('debug', &
                & 'caf', &
                & OS_ALL, &
                & flags = ' -Wall -Wextra -Wimplicit-interface -fPIC -fmax-errors=1 -g -fcheck=bounds&
                          & -fcheck=array-temps -fbacktrace', &
                & is_built_in=.true.), &
              & new_profile('debug', &
                & 'gfortran', &
                & OS_ALL, &
                & flags = ' -Wall -Wextra -Wimplicit-interface -fPIC -fmax-errors=1 -g -fcheck=bounds&
                          & -fcheck=array-temps -fbacktrace -fcoarray=single', &
                & is_built_in=.true.), &
              & new_profile('debug', &
                & 'f95', &
                & OS_ALL, &
                & flags = ' -Wall -Wextra -Wimplicit-interface -fPIC -fmax-errors=1 -g -fcheck=bounds&
                          & -fcheck=array-temps -Wno-maybe-uninitialized -Wno-uninitialized -fbacktrace', &
                & is_built_in=.true.), &
              & new_profile('debug', &
                & 'nvfortran', &
                & OS_ALL, &
                & flags = ' -Minform=inform -Mbackslash -g -Mbounds -Mchkptr -Mchkstk -traceback', &
                & is_built_in=.true.), &
              & new_profile('debug', &
                & 'ifort', &
                & OS_ALL, &
                & flags = ' -warn all -check all -error-limit 1 -O0 -g -assume byterecl -traceback', &
                & is_built_in=.true.), &
              & new_profile('debug', &
                & 'ifort', &
                & OS_WINDOWS, &
                & flags = ' /warn:all /check:all /error-limit:1&
                          & /Od /Z7 /assume:byterecl /traceback', &
                & is_built_in=.true.), &
              & new_profile('debug', &
                & 'ifx', &
                & OS_ALL, &
                & flags = ' -warn all -check all -error-limit 1 -O0 -g -assume byterecl -traceback', &
                & is_built_in=.true.), &
              & new_profile('debug', &
                & 'ifx', &
                & OS_WINDOWS, &
                & flags = ' /warn:all /check:all /error-limit:1 /Od /Z7 /assume:byterecl', &
                & is_built_in=.true.), &
              & new_profile('debug', &
                & 'ifx', &
                & OS_WINDOWS, &
                & flags = ' /warn:all /check:all /error-limit:1 /Od /Z7 /assume:byterecl', &
                & is_built_in=.true.), &
              & new_profile('debug', &
                & 'lfortran', &
                & OS_ALL, &
                & flags = '', &
                & is_built_in=.true.) &
              &]
      end function get_default_profiles

      !> Write information on instance
      subroutine info(self, unit, verbosity)

        !> Instance of the profile configuration
        class(profile_config_t), intent(in) :: self

        !> Unit for IO
        integer, intent(in) :: unit

        !> Verbosity of the printout
        integer, intent(in), optional :: verbosity

        integer :: pr
        character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)'

        if (present(verbosity)) then
            pr = verbosity
        else
            pr = 1
        end if

        write(unit, fmt) "Profile"
        if (allocated(self%profile_name)) then
            write(unit, fmt) "- profile name", self%profile_name
        end if

        if (allocated(self%compiler)) then
            write(unit, fmt) "- compiler", self%compiler
        end if

        write(unit, fmt) "- os", os_type_name(self%os_type)

        if (allocated(self%flags)) then
            write(unit, fmt) "- compiler flags", self%flags
        end if

      end subroutine info

      !> Print a representation of profile_config_t
      function info_profile(profile) result(s)

        !> Profile to be represented
        type(profile_config_t), intent(in) :: profile

        !> String representation of given profile
        character(:), allocatable :: s

        integer :: i

        s = "profile_config_t("
        s = s // 'profile_name="' // profile%profile_name // '"'
        s = s // ', compiler="' // profile%compiler // '"'
        s = s // ", os_type="
        select case(profile%os_type)
        case (OS_UNKNOWN)
          s = s // "OS_UNKNOWN"
        case (OS_LINUX)
          s = s // "OS_LINUX"
        case (OS_MACOS)
          s = s // "OS_MACOS"
        case (OS_WINDOWS)
          s = s // "OS_WINDOWS"
        case (OS_CYGWIN)
          s = s // "OS_CYGWIN"
        case (OS_SOLARIS)
          s = s // "OS_SOLARIS"
        case (OS_FREEBSD)
          s = s // "OS_FREEBSD"
        case (OS_OPENBSD)
          s = s // "OS_OPENBSD"
        case (OS_ALL)
          s = s // "OS_ALL"
        case default
          s = s // "INVALID"
        end select
        if (allocated(profile%flags)) s = s // ', flags="' // profile%flags // '"'
        if (allocated(profile%c_flags)) s = s // ', c_flags="' // profile%c_flags // '"'
        if (allocated(profile%cxx_flags)) s = s // ', cxx_flags="' // profile%cxx_flags // '"'
        if (allocated(profile%link_time_flags)) s = s // ', link_time_flags="' // profile%link_time_flags // '"'
        if (allocated(profile%file_scope_flags)) then
          do i=1,size(profile%file_scope_flags)
            s = s // ', flags for '//profile%file_scope_flags(i)%file_name// &
                    & ' ="' // profile%file_scope_flags(i)%flags // '"'
          end do
        end if
        s = s // ")"

      end function info_profile

      !> Look for profile with given configuration in array profiles
      subroutine find_profile(profiles, profile_name, compiler, os_type, found_matching, chosen_profile)

        !> Array of profiles
        type(profile_config_t), allocatable, intent(in) :: profiles(:)

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

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

        !> Type of operating system (enum)
        integer, intent(in) :: os_type

        !> Boolean value containing true if matching profile was found
        logical, intent(out) :: found_matching

        !> Last matching profile in the profiles array
        type(profile_config_t), intent(out) :: chosen_profile

        character(:), allocatable :: curr_profile_name
        character(:), allocatable :: curr_compiler
        integer :: curr_os
        integer :: i, priority, curr_priority

        found_matching = .false.
        if (size(profiles) < 1) return
        ! Try to find profile with matching OS type
        do i=1,size(profiles)
          curr_profile_name = profiles(i)%profile_name
          curr_compiler = profiles(i)%compiler
          curr_os = profiles(i)%os_type
          if (curr_profile_name.eq.profile_name) then
            if (curr_compiler.eq.compiler) then
              if (curr_os.eq.os_type) then
                chosen_profile = profiles(i)
                found_matching = .true.
              end if
            end if
          end if
        end do
        ! Try to find profile with OS type 'all'
        if (.not. found_matching) then
          do i=1,size(profiles)
            curr_profile_name = profiles(i)%profile_name
            curr_compiler = profiles(i)%compiler
            curr_os = profiles(i)%os_type
            if (curr_profile_name.eq.profile_name) then
              if (curr_compiler.eq.compiler) then
                if (curr_os.eq.OS_ALL) then
                  chosen_profile = profiles(i)
                  found_matching = .true.
                end if
              end if
            end if
          end do
        end if
      end subroutine find_profile


      logical function file_scope_same(this,that)
          class(file_scope_flag), intent(in) :: this
          class(serializable_t), intent(in) :: that

          file_scope_same = .false.

          select type (other=>that)
             type is (file_scope_flag)
                if (allocated(this%file_name).neqv.allocated(other%file_name)) return
                if (allocated(this%file_name)) then
                    if (.not.(this%file_name==other%file_name)) return
                endif
                if (allocated(this%flags).neqv.allocated(other%flags)) return
                if (allocated(this%flags)) then
                    if (.not.(this%flags==other%flags)) return
                endif

             class default
                ! Not the same type
                return
          end select

          !> All checks passed!
          file_scope_same = .true.

    end function file_scope_same

    !> Dump to toml table
    subroutine file_scope_dump(self, table, error)

       !> Instance of the serializable object
       class(file_scope_flag), intent(inout) :: self

       !> Data structure
       type(toml_table), intent(inout) :: table

       !> Error handling
       type(error_t), allocatable, intent(out) :: error

       call set_string(table, "file-name", self%file_name, error)
       if (allocated(error)) return
       call set_string(table, "flags", self%flags, error)
       if (allocated(error)) return

     end subroutine file_scope_dump

     !> Read from toml table (no checks made at this stage)
     subroutine file_scope_load(self, table, error)

        !> Instance of the serializable object
        class(file_scope_flag), intent(inout) :: self

        !> Data structure
        type(toml_table), intent(inout) :: table

        !> Error handling
        type(error_t), allocatable, intent(out) :: error

        call get_value(table, "file-name", self%file_name)
        call get_value(table, "flags", self%flags)

     end subroutine file_scope_load

      logical function profile_same(this,that)
          class(profile_config_t), intent(in) :: this
          class(serializable_t), intent(in) :: that

          integer :: ii

          profile_same = .false.

          select type (other=>that)
             type is (profile_config_t)
                if (allocated(this%profile_name).neqv.allocated(other%profile_name)) return
                if (allocated(this%profile_name)) then
                    if (.not.(this%profile_name==other%profile_name)) return
                endif
                if (allocated(this%compiler).neqv.allocated(other%compiler)) return
                if (allocated(this%compiler)) then
                    if (.not.(this%compiler==other%compiler)) return
                endif
                if (this%os_type/=other%os_type) return
                if (allocated(this%flags).neqv.allocated(other%flags)) return
                if (allocated(this%flags)) then
                    if (.not.(this%flags==other%flags)) return
                endif
                if (allocated(this%c_flags).neqv.allocated(other%c_flags)) return
                if (allocated(this%c_flags)) then
                    if (.not.(this%c_flags==other%c_flags)) return
                endif
                if (allocated(this%cxx_flags).neqv.allocated(other%cxx_flags)) return
                if (allocated(this%cxx_flags)) then
                    if (.not.(this%cxx_flags==other%cxx_flags)) return
                endif
                if (allocated(this%link_time_flags).neqv.allocated(other%link_time_flags)) return
                if (allocated(this%link_time_flags)) then
                    if (.not.(this%link_time_flags==other%link_time_flags)) return
                endif

                if (allocated(this%file_scope_flags).neqv.allocated(other%file_scope_flags)) return
                if (allocated(this%file_scope_flags)) then
                    if (.not.size(this%file_scope_flags)==size(other%file_scope_flags)) return
                    do ii=1,size(this%file_scope_flags)
                        print *, 'check ii-th file scope: ',ii
                       if (.not.this%file_scope_flags(ii)==other%file_scope_flags(ii)) return
                    end do
                endif

                if (this%is_built_in.neqv.other%is_built_in) return

             class default
                ! Not the same type
                return
          end select

          !> All checks passed!
          profile_same = .true.

    end function profile_same

    !> Dump to toml table
    subroutine profile_dump(self, table, error)

       !> Instance of the serializable object
       class(profile_config_t), intent(inout) :: self

       !> Data structure
       type(toml_table), intent(inout) :: table

       !> Error handling
       type(error_t), allocatable, intent(out) :: error

       !> Local variables
       integer :: ierr, ii
       type(toml_table), pointer :: ptr_deps, ptr
       character(len=30) :: unnamed

       call set_string(table, "profile-name", self%profile_name, error)
       if (allocated(error)) return
       call set_string(table, "compiler", self%compiler, error)
       if (allocated(error)) return
       call set_string(table,"os-type",os_type_name(self%os_type), error, 'profile_config_t')
       if (allocated(error)) return
       call set_string(table, "flags", self%flags, error)
       if (allocated(error)) return
       call set_string(table, "c-flags", self%c_flags, error)
       if (allocated(error)) return
       call set_string(table, "cxx-flags", self%cxx_flags, error)
       if (allocated(error)) return
       call set_string(table, "link-time-flags", self%link_time_flags, error)
       if (allocated(error)) return

       if (allocated(self%file_scope_flags)) then

           ! Create dependency table
           call add_table(table, "file-scope-flags", ptr_deps)
           if (.not. associated(ptr_deps)) then
              call fatal_error(error, "profile_config_t cannot create file scope table ")
              return
           end if

           do ii = 1, size(self%file_scope_flags)
              associate (dep => self%file_scope_flags(ii))

                 !> Because files need a name, fallback if this has no name
                 if (len_trim(dep%file_name)==0) then
                    write(unnamed,1) ii
                    call add_table(ptr_deps, trim(unnamed), ptr)
                 else
                    call add_table(ptr_deps, dep%file_name, ptr)
                 end if
                 if (.not. associated(ptr)) then
                    call fatal_error(error, "profile_config_t cannot create entry for file "//dep%file_name)
                    return
                 end if
                 call dep%dump_to_toml(ptr, error)
                 if (allocated(error)) return
              end associate
           end do

       endif

       call set_value(table, "is-built-in", self%is_built_in, error, 'profile_config_t')
       if (allocated(error)) return

       1 format('UNNAMED_FILE_',i0)

     end subroutine profile_dump

     !> Read from toml table (no checks made at this stage)
     subroutine profile_load(self, table, error)

        !> Instance of the serializable object
        class(profile_config_t), intent(inout) :: self

        !> Data structure
        type(toml_table), intent(inout) :: table

        !> Error handling
        type(error_t), allocatable, intent(out) :: error

        !> Local variables
        character(len=:), allocatable :: flag
        integer :: ii, jj
        type(toml_table), pointer :: ptr_dep, ptr
        type(toml_key), allocatable :: keys(:),dep_keys(:)

        call table%get_keys(keys)

        call get_value(table, "profile-name", self%profile_name)
        call get_value(table, "compiler", self%compiler)
        call get_value(table,"os-type",flag)
        call match_os_type(flag, self%os_type)
        call get_value(table, "flags", self%flags)
        call get_value(table, "c-flags", self%c_flags)
        call get_value(table, "cxx-flags", self%cxx_flags)
        call get_value(table, "link-time-flags", self%link_time_flags)
        call get_value(table, "is-built-in", self%is_built_in, error, 'profile_config_t')
        if (allocated(error)) return

        if (allocated(self%file_scope_flags)) deallocate(self%file_scope_flags)
        sub_deps: do ii = 1, size(keys)

           select case (keys(ii)%key)
              case ("file-scope-flags")

               call get_value(table, keys(ii), ptr)
               if (.not.associated(ptr)) then
                  call fatal_error(error,'profile_config_t: error retrieving file_scope_flags table')
                  return
               end if

               !> Read all packages
               call ptr%get_keys(dep_keys)
               allocate(self%file_scope_flags(size(dep_keys)))

               do jj = 1, size(dep_keys)

                   call get_value(ptr, dep_keys(jj), ptr_dep)
                   call self%file_scope_flags(jj)%load_from_toml(ptr_dep, error)
                   if (allocated(error)) return

               end do

           end select
        end do sub_deps

     end subroutine profile_load


end module fpm_manifest_profile