fpm_model.f90 Source File


Source Code

!># The fpm package model
!>
!> Defines the fpm model data types which encapsulate all information
!> required to correctly build a package and its dependencies.
!>
!> The process (see `[[build_model(subroutine)]]`) for generating a valid `[[fpm_model]]` involves
!>  source files discovery ([[fpm_sources]]) and parsing ([[fpm_source_parsing]]).
!>
!> Once a valid `[[fpm_model]]` has been constructed, it may be passed to `[[fpm_targets:targets_from_sources]]` to
!> generate a list of build targets for the backend.
!>
!>### Enumerations
!>
!> __Source type:__ `FPM_UNIT_*`
!> Describes the type of source file — determines build target generation
!>
!> The logical order of precedence for assigning `unit_type` is as follows:
!>
!>```
!> if source-file contains program then
!>   unit_type = FPM_UNIT_PROGRAM
!> else if source-file contains non-module subroutine/function then
!>   unit_type = FPM_UNIT_SUBPROGRAM
!> else if source-file contains submodule then
!>   unit_type = FPM_UNIT_SUBMODULE
!> else if source-file contains module then
!>   unit_type = FPM_UNIT_MODULE
!> end if
!>```
!>
!> @note A source file is only designated `FPM_UNIT_MODULE` if it **only** contains modules - no non-module subprograms.
!> (This allows tree-shaking/pruning of build targets based on unused module dependencies.)
!>
!> __Source scope:__ `FPM_SCOPE_*`
!> Describes the scoping rules for using modules — controls module dependency resolution
!>
module fpm_model
use iso_fortran_env, only: int64
use fpm_compiler, only: compiler_t, archiver_t, debug
use fpm_dependency, only: dependency_tree_t
use fpm_strings, only: string_t, str, len_trim, upper, operator(==)
use fpm_toml, only: serializable_t, toml_table, toml_stat, set_value, set_list, get_value, &
                    & get_list, add_table, toml_key, add_array, set_string
use fpm_error, only: error_t, fatal_error
use fpm_manifest_preprocess, only: preprocess_config_t
implicit none

private
public :: fpm_model_t, srcfile_t, show_model, fortran_features_t, package_t

public :: FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, &
          FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, &
          FPM_UNIT_CHEADER, FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, &
          FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_EXAMPLE, FPM_SCOPE_TEST, &
          FPM_UNIT_CPPSOURCE, FPM_SCOPE_NAME, FPM_UNIT_NAME

!> Source type unknown
integer, parameter :: FPM_UNIT_UNKNOWN = -1
!> Source contains a fortran program
integer, parameter :: FPM_UNIT_PROGRAM = 1
!> Source **only** contains one or more fortran modules
integer, parameter :: FPM_UNIT_MODULE = 2
!> Source contains one or more fortran submodules
integer, parameter :: FPM_UNIT_SUBMODULE = 3
!> Source contains one or more fortran subprogram not within modules
integer, parameter :: FPM_UNIT_SUBPROGRAM = 4
!> Source type is c source file
integer, parameter :: FPM_UNIT_CSOURCE = 5
!> Source type is c header file
integer, parameter :: FPM_UNIT_CHEADER = 6
!> Souce type is c++ source file.
integer, parameter :: FPM_UNIT_CPPSOURCE = 7

!> Source has no module-use scope
integer, parameter :: FPM_SCOPE_UNKNOWN = -1
!> Module-use scope is library/dependency modules only
integer, parameter :: FPM_SCOPE_LIB = 1
!> Module-use scope is library/dependency modules only
integer, parameter :: FPM_SCOPE_DEP = 2
!> Module-use scope is library/dependency and app modules
integer, parameter :: FPM_SCOPE_APP = 3
!> Module-use scope is library/dependency and test modules
integer, parameter :: FPM_SCOPE_TEST = 4
integer, parameter :: FPM_SCOPE_EXAMPLE = 5

!> Enabled Fortran language features
type, extends(serializable_t) :: fortran_features_t

    !> Use default implicit typing
    logical :: implicit_typing = .false.

    !> Use implicit external interface
    logical :: implicit_external = .false.

    !> Form to use for all Fortran sources
    character(:), allocatable :: source_form

    contains

        !> Serialization interface
        procedure :: serializable_is_same => fft_is_same
        procedure :: dump_to_toml   => fft_dump_to_toml
        procedure :: load_from_toml => fft_load_from_toml

end type fortran_features_t

!> Type for describing a source file
type, extends(serializable_t) :: srcfile_t
    !> File path relative to cwd
    character(:), allocatable :: file_name

    !> Name of executable for FPM_UNIT_PROGRAM
    character(:), allocatable :: exe_name

    !> Target module-use scope
    integer :: unit_scope = FPM_SCOPE_UNKNOWN

    !> Modules provided by this source file (lowerstring)
    type(string_t), allocatable :: modules_provided(:)

    !> Type of source unit
    integer :: unit_type = FPM_UNIT_UNKNOWN

    !> Parent modules (submodules only)
    type(string_t), allocatable :: parent_modules(:)

    !>  Modules USEd by this source file (lowerstring)
    type(string_t), allocatable :: modules_used(:)

    !> Files INCLUDEd by this source file
    type(string_t), allocatable :: include_dependencies(:)

    !> Native libraries to link against
    type(string_t), allocatable :: link_libraries(:)

    !> Current hash
    integer(int64) :: digest

    contains

        !> Serialization interface
        procedure :: serializable_is_same => srcfile_is_same
        procedure :: dump_to_toml   => srcfile_dump_to_toml
        procedure :: load_from_toml => srcfile_load_from_toml

end type srcfile_t


!> Type for describing a single package
type, extends(serializable_t) :: package_t

    !> Name of package
    character(:), allocatable :: name

    !> Array of sources
    type(srcfile_t), allocatable :: sources(:)

    !> List of macros.
    type(preprocess_config_t) :: preprocess

    !> Package version number.
    character(:), allocatable :: version

    !> Module naming conventions
    logical :: enforce_module_names = .false.

    !> Prefix for all module names
    type(string_t) :: module_prefix

    !> Language features
    type(fortran_features_t) :: features

    contains

        !> Serialization interface
        procedure :: serializable_is_same => package_is_same
        procedure :: dump_to_toml   => package_dump_to_toml
        procedure :: load_from_toml => package_load_from_toml

end type package_t


!> Type describing everything required to build
!>  the root package and its dependencies.
type, extends(serializable_t) :: fpm_model_t

    !> Name of root package
    character(:), allocatable :: package_name

    !> Array of packages (including the root package)
    type(package_t), allocatable :: packages(:)

    !> Compiler object
    type(compiler_t) :: compiler

    !> Archiver object
    type(archiver_t) :: archiver

    !> Command line flags passed to fortran for compilation
    character(:), allocatable :: fortran_compile_flags

    !> Command line flags passed to C for compilation
    character(:), allocatable :: c_compile_flags

    !> Command line flags passed to C++ for compilation
    character(:), allocatable :: cxx_compile_flags

    !> Command line flags passed to the linker
    character(:), allocatable :: link_flags

    !> Base directory for build
    character(:), allocatable :: build_prefix

    !> Include directories
    type(string_t), allocatable :: include_dirs(:)

    !> Native libraries to link against
    type(string_t), allocatable :: link_libraries(:)

    !> External modules used
    type(string_t), allocatable :: external_modules(:)

    !> Project dependencies
    type(dependency_tree_t) :: deps

    !> Whether tests should be added to the build list
    logical :: include_tests = .true.

    !> Whether module names should be prefixed with the package name
    logical :: enforce_module_names = .false.

    !> Prefix for all module names
    type(string_t) :: module_prefix

    contains

        !> Serialization interface
        procedure :: serializable_is_same => model_is_same
        procedure :: dump_to_toml   => model_dump_to_toml
        procedure :: load_from_toml => model_load_from_toml

end type fpm_model_t

contains


function info_package(p) result(s)
    ! Returns representation of package_t
    type(package_t), intent(in) :: p
    character(:), allocatable :: s

    integer :: i

    s = s // 'package_t('
    s = s // 'name="' // p%name //'"'
    s = s // ', sources=['
    do i = 1, size(p%sources)
        s = s // info_srcfile(p%sources(i))
        if (i < size(p%sources)) s = s // ", "
    end do
    s = s // "]"

    ! Print module naming convention
    s = s // ', enforce_module_names="' // merge('T','F',p%enforce_module_names) // '"'

    ! Print custom prefix
    if (p%enforce_module_names .and. len_trim(p%module_prefix)>0) &
    s = s // ', custom_prefix="' // p%module_prefix%s // '"'

    s = s // ")"

end function info_package

function info_srcfile(source) result(s)
    type(srcfile_t), intent(in) :: source
    character(:), allocatable :: s
    integer :: i
    !type srcfile_t
    s = "srcfile_t("
    !    character(:), allocatable :: file_name
    s = s // 'file_name="' // source%file_name // '"'
    !    character(:), allocatable :: exe_name
    s = s // ', exe_name="' // source%exe_name // '"'
    !    integer :: unit_scope = FPM_SCOPE_UNKNOWN
    s = s // ', unit_scope="' // FPM_SCOPE_NAME(source%unit_scope) // '"'
    !    type(string_t), allocatable :: modules_provided(:)
    s = s // ", modules_provided=["
    do i = 1, size(source%modules_provided)
        s = s // '"' // source%modules_provided(i)%s // '"'
        if (i < size(source%modules_provided)) s = s // ", "
    end do
    s = s // "]"
    s = s // ", parent_modules=["
    do i = 1, size(source%parent_modules)
        s = s // '"' // source%parent_modules(i)%s // '"'
        if (i < size(source%parent_modules)) s = s // ", "
    end do
    s = s // "]"
    !    integer :: unit_type = FPM_UNIT_UNKNOWN
    s = s // ', unit_type="' // FPM_UNIT_NAME(source%unit_type) // '"'
    !    type(string_t), allocatable :: modules_used(:)
    s = s // ", modules_used=["
    do i = 1, size(source%modules_used)
        s = s // '"' // source%modules_used(i)%s // '"'
        if (i < size(source%modules_used)) s = s // ", "
    end do
    s = s // "]"
    !    type(string_t), allocatable :: include_dependencies(:)
    s = s // ", include_dependencies=["
    do i = 1, size(source%include_dependencies)
        s = s // '"' // source%include_dependencies(i)%s // '"'
        if (i < size(source%include_dependencies)) s = s // ", "
    end do
    s = s // "]"
    !    type(string_t), allocatable :: link_libraries(:)
    s = s // ", link_libraries=["
    do i = 1, size(source%link_libraries)
        s = s // '"' // source%link_libraries(i)%s // '"'
        if (i < size(source%link_libraries)) s = s // ", "
    end do
    s = s // "]"
    !    integer(int64) :: digest
    s = s // ", digest=" // str(source%digest)
    !end type srcfile_t
    s = s // ")"
end function info_srcfile

function info_srcfile_short(source) result(s)
    ! Prints a shortened version of srcfile_t
    type(srcfile_t), intent(in) :: source
    character(:), allocatable :: s
    s = "srcfile_t("
    s = s // 'file_name="' // source%file_name // '"'
    s = s // ", ...)"
end function info_srcfile_short

function info_model(model) result(s)
    type(fpm_model_t), intent(in) :: model
    character(:), allocatable :: s
    integer :: i
    !type :: fpm_model_t
    s = "fpm_model_t("
    !    character(:), allocatable :: package_name
    s = s // 'package_name="' // model%package_name // '"'
    !    type(srcfile_t), allocatable :: sources(:)
    s = s // ", packages=["
    do i = 1, size(model%packages)
        s = s // info_package(model%packages(i))
        if (i < size(model%packages)) s = s // ", "
    end do
    s = s // "]"
    s = s // ', compiler=(' // debug(model%compiler) // ')'
    s = s // ', archiver=(' // debug(model%archiver) // ')'
    !    character(:), allocatable :: fortran_compile_flags
    s = s // ', fortran_compile_flags="' // model%fortran_compile_flags // '"'
    s = s // ', c_compile_flags="' // model%c_compile_flags // '"'
    s = s // ', cxx_compile_flags="' // model%cxx_compile_flags // '"'
    s = s // ', link_flags="' // model%link_flags // '"'
    s = s // ', build_prefix="' // model%build_prefix // '"'
    !    type(string_t), allocatable :: link_libraries(:)
    s = s // ", link_libraries=["
    do i = 1, size(model%link_libraries)
        s = s // '"' // model%link_libraries(i)%s // '"'
        if (i < size(model%link_libraries)) s = s // ", "
    end do
    s = s // "]"
    !    type(string_t), allocatable :: external_modules(:)
    s = s // ", external_modules=["
    do i = 1, size(model%external_modules)
        s = s // '"' // model%external_modules(i)%s // '"'
        if (i < size(model%external_modules)) s = s // ", "
    end do
    s = s // "]"
    !    type(dependency_tree_t) :: deps
    ! TODO: print `dependency_tree_t` properly, which should become part of the
    !       model, not imported from another file
    s = s // ", deps=dependency_tree_t(...)"

    ! Print module naming convention
    s = s // ', enforce_module_names="' // merge('T','F',model%enforce_module_names) // '"'

    ! Print custom prefix
    if (model%enforce_module_names .and. len_trim(model%module_prefix)>0) &
    s = s // ', custom_prefix="' // model%module_prefix%s // '"'

    !end type fpm_model_t
    s = s // ")"
end function info_model

subroutine show_model(model)
    ! Prints a human readable representation of the Model
    type(fpm_model_t), intent(in) :: model
    print *, info_model(model)
end subroutine show_model

!> Return the character name of a scope flag
function FPM_SCOPE_NAME(flag) result(name)
    integer, intent(in) :: flag
    character(len=:), allocatable :: name

    select case (flag)
       case (FPM_SCOPE_UNKNOWN); name = "FPM_SCOPE_UNKNOWN"
       case (FPM_SCOPE_LIB);     name = "FPM_SCOPE_LIB"
       case (FPM_SCOPE_DEP);     name = "FPM_SCOPE_DEP"
       case (FPM_SCOPE_APP);     name = "FPM_SCOPE_APP"
       case (FPM_SCOPE_TEST);    name = "FPM_SCOPE_TEST"
       case (FPM_SCOPE_EXAMPLE); name = "FPM_SCOPE_EXAMPLE"
       case default;             name = "INVALID"
    end select
end function FPM_SCOPE_NAME

!> Parse git FPM_SCOPE identifier from a string
integer function parse_scope(name) result(scope)
    character(len=*), intent(in) :: name

    character(len=len(name)) :: uppercase

    !> Make it Case insensitive
    uppercase = upper(name)

    select case (trim(uppercase))
       case ("FPM_SCOPE_UNKNOWN"); scope = FPM_SCOPE_UNKNOWN
       case ("FPM_SCOPE_LIB");     scope = FPM_SCOPE_LIB
       case ("FPM_SCOPE_DEP");     scope = FPM_SCOPE_DEP
       case ("FPM_SCOPE_APP");     scope = FPM_SCOPE_APP
       case ("FPM_SCOPE_TEST");    scope = FPM_SCOPE_TEST
       case ("FPM_SCOPE_EXAMPLE"); scope = FPM_SCOPE_EXAMPLE
       case default;               scope = -9999
    end select

end function parse_scope

!> Return the character name of a unit flag
function FPM_UNIT_NAME(flag) result(name)
    integer, intent(in) :: flag
    character(len=:), allocatable :: name

    select case (flag)
       case (FPM_UNIT_UNKNOWN);    name = "FPM_UNIT_UNKNOWN"
       case (FPM_UNIT_PROGRAM);    name = "FPM_UNIT_PROGRAM"
       case (FPM_UNIT_MODULE);     name = "FPM_UNIT_MODULE"
       case (FPM_UNIT_SUBMODULE);  name = "FPM_UNIT_SUBMODULE"
       case (FPM_UNIT_SUBPROGRAM); name = "FPM_UNIT_SUBPROGRAM"
       case (FPM_UNIT_CSOURCE);    name = "FPM_UNIT_CSOURCE"
       case (FPM_UNIT_CPPSOURCE);  name = "FPM_UNIT_CPPSOURCE"
       case (FPM_UNIT_CHEADER);    name = "FPM_UNIT_CHEADER"
       case default;               name = "INVALID"
    end select
end function FPM_UNIT_NAME

!> Parse git FPM_UNIT identifier from a string
integer function parse_unit(name) result(unit)
    character(len=*), intent(in) :: name

    character(len=len(name)) :: uppercase

    !> Make it Case insensitive
    uppercase = upper(name)

    select case (trim(uppercase))
       case ("FPM_UNIT_UNKNOWN");    unit = FPM_UNIT_UNKNOWN
       case ("FPM_UNIT_PROGRAM");    unit = FPM_UNIT_PROGRAM
       case ("FPM_UNIT_MODULE");     unit = FPM_UNIT_MODULE
       case ("FPM_UNIT_SUBMODULE");  unit = FPM_UNIT_SUBMODULE
       case ("FPM_UNIT_SUBPROGRAM"); unit = FPM_UNIT_SUBPROGRAM
       case ("FPM_UNIT_CSOURCE");    unit = FPM_UNIT_CSOURCE
       case ("FPM_UNIT_CPPSOURCE");  unit = FPM_UNIT_CPPSOURCE
       case ("FPM_UNIT_CHEADER");    unit = FPM_UNIT_CHEADER
       case default;                 unit = -9999
    end select

end function parse_unit

!> Check that two source files are equal
logical function srcfile_is_same(this,that)
    class(srcfile_t), intent(in) :: this
    class(serializable_t), intent(in) :: that

    srcfile_is_same = .false.

    select type (other=>that)
       type is (srcfile_t)

          if (.not.(this%file_name==other%file_name)) return
          if (.not.(this%exe_name==other%exe_name)) return
          if (.not.(this%unit_scope==other%unit_scope)) return
          if (.not.(this%modules_provided==other%modules_provided)) return
          if (.not.(this%unit_type==other%unit_type)) return
          if (.not.(this%parent_modules==other%parent_modules)) return
          if (.not.(this%modules_used==other%modules_used)) return
          if (.not.(this%include_dependencies==other%include_dependencies)) return
          if (.not.(this%link_libraries==other%link_libraries)) return
          if (.not.(this%digest==other%digest)) return

       class default
          ! Not the same type
          return
    end select

    !> All checks passed!
    srcfile_is_same = .true.

end function srcfile_is_same

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

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

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

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

    integer :: ierr

    call set_string(table, "file-name", self%file_name, error, 'srcfile_t')
    if (allocated(error)) return
    call set_string(table, "exe-name", self%exe_name, error, 'srcfile_t')
    if (allocated(error)) return
    call set_value(table, "digest", self%digest, error, 'srcfile_t')
    if (allocated(error)) return

    ! unit_scope and unit_type are saved as strings so the output is independent
    ! of the internal representation
    call set_string(table,"unit-scope",FPM_SCOPE_NAME(self%unit_scope), error, 'srcfile_t')
    if (allocated(error)) return
    call set_string(table,"unit-type",FPM_UNIT_NAME(self%unit_type), error, 'srcfile_t')
    if (allocated(error)) return
    call set_list(table, "modules-provided",self%modules_provided, error)
    if (allocated(error)) return
    call set_list(table, "parent-modules",self%parent_modules, error)
    if (allocated(error)) return
    call set_list(table, "modules-used",self%modules_used, error)
    if (allocated(error)) return
    call set_list(table, "include-dependencies",self%include_dependencies, error)
    if (allocated(error)) return
    call set_list(table, "link-libraries",self%link_libraries, error)
    if (allocated(error)) return

end subroutine srcfile_dump_to_toml

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

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

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

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

    character(len=:), allocatable :: flag
    integer :: ierr

    call get_value(table, "file-name", self%file_name)
    call get_value(table, "exe-name", self%exe_name)
    call get_value(table, "digest", self%digest, error, 'srcfile_t')
    if (allocated(error)) return

    ! unit_scope and unit_type are saved as strings so the output is independent
    ! of the internal representation
    call get_value(table, "unit-scope", flag)
    if (allocated(flag)) self%unit_scope = parse_scope(flag)
    call get_value(table, "unit-type", flag)
    if (allocated(flag)) self%unit_type = parse_unit(flag)

    call get_list(table,"modules-provided",self%modules_provided, error)
    if (allocated(error)) return

    call get_list(table,"parent-modules",self%parent_modules, error)
    if (allocated(error)) return

    call get_list(table,"modules-used",self%modules_used, error)
    if (allocated(error)) return

    call get_list(table,"include-dependencies",self%include_dependencies, error)
    if (allocated(error)) return

    call get_list(table,"link-libraries",self%link_libraries, error)
    if (allocated(error)) return

end subroutine srcfile_load_from_toml

!> Check that two fortran feature objects are equal
logical function fft_is_same(this,that)
    class(fortran_features_t), intent(in) :: this
    class(serializable_t), intent(in) :: that

    fft_is_same = .false.

    select type (other=>that)
       type is (fortran_features_t)

           if (.not.(this%implicit_typing.eqv.other%implicit_typing)) return
           if (.not.(this%implicit_external.eqv.other%implicit_external)) return
           if (.not.(this%source_form==other%source_form)) return

       class default
          ! Not the same type
          return
    end select

    !> All checks passed!
    fft_is_same = .true.

end function fft_is_same

!> Dump fortran features to toml table
subroutine fft_dump_to_toml(self, table, error)

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

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

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

    call set_value(table, "implicit-typing", self%implicit_typing, error, 'fortran_features_t')
    if (allocated(error)) return
    call set_value(table, "implicit-external", self%implicit_external, error, 'fortran_features_t')
    if (allocated(error)) return
    call set_string(table, "source-form", self%source_form, error, 'fortran_features_t')
    if (allocated(error)) return

end subroutine fft_dump_to_toml

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

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

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

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

    integer :: ierr

    call get_value(table, "implicit-typing", self%implicit_typing, error, 'fortran_features_t')
    if (allocated(error)) return
    call get_value(table, "implicit-external", self%implicit_external, error, 'fortran_features_t')
    if (allocated(error)) return
    ! Return unallocated value if not present
    call get_value(table, "source-form", self%source_form)

end subroutine fft_load_from_toml

!> Check that two package objects are equal
logical function package_is_same(this,that)
    class(package_t), intent(in) :: this
    class(serializable_t), intent(in) :: that

    integer :: ii

    package_is_same = .false.

    select type (other=>that)
       type is (package_t)

           if (.not.(this%name==other%name)) return
           if (.not.(allocated(this%sources).eqv.allocated(other%sources))) return
           if (allocated(this%sources)) then
              if (.not.(size(this%sources)==size(other%sources))) return
              do ii = 1, size(this%sources)
                  if (.not.(this%sources(ii)==other%sources(ii))) return
              end do
           end if

           if (.not.(this%preprocess==other%preprocess)) return
           if (.not.(this%version==other%version)) return

           !> Module naming
           if (.not.(this%enforce_module_names.eqv.other%enforce_module_names)) return
           if (.not.(this%module_prefix==other%module_prefix)) return

           !> Fortran features
           if (.not.(this%features==other%features)) return

       class default
          ! Not the same type
          return
    end select

    !> All checks passed!
    package_is_same = .true.

end function package_is_same

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

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

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

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

    integer :: ierr, ii
    type(toml_table), pointer :: ptr,this_source
    character(16) :: src_name

    call set_string(table, "name", self%name, error, 'package_t')
    if (allocated(error)) return

    call set_string(table, "version", self%version, error, 'package_t')
    if (allocated(error)) return

    call set_value(table, "module-naming", self%enforce_module_names, error, 'package_t')
    if (allocated(error)) return

    call set_string(table, "module-prefix", self%module_prefix, error, 'package_t')
    if (allocated(error)) return

    !> Create a preprocessor table
    call add_table(table, "preprocess", ptr, error, 'package_t')
    if (allocated(error)) return
    call self%preprocess%dump_to_toml(ptr, error)
    if (allocated(error)) return

    !> Create a fortran table
    call add_table(table, "fortran", ptr, error, 'package_t')
    if (allocated(error)) return
    call self%features%dump_to_toml(ptr, error)
    if (allocated(error)) return

    !> Create a sources table
    if (allocated(self%sources)) then

        call add_table(table, "sources", ptr, error, 'package_t')
        if (allocated(error)) return

        do ii = 1, size(self%sources)

            write(src_name,1) ii
            call add_table(ptr, trim(src_name), this_source, error, 'package_t[source]')
            if (allocated(error)) return
            call self%sources(ii)%dump_to_toml(this_source,error)
            if (allocated(error)) return

        end do

    end if

    1 format('src_',i0)

end subroutine package_dump_to_toml

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

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

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

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

    integer :: ierr,ii,jj
    type(toml_key), allocatable :: keys(:),src_keys(:)
    type(toml_table), pointer :: ptr_sources,ptr,ptr_fortran,ptr_preprocess
    type(error_t), allocatable :: new_error

    call get_value(table, "name", self%name)
    call get_value(table, "version", self%version)

    call get_value(table, "module-naming", self%enforce_module_names, error, 'package_t')
    if (allocated(error)) return

    ! Return unallocated value if not present
    call get_value(table, "module-prefix", self%module_prefix%s)

    ! Sources
    call table%get_keys(keys)

    find_others: do ii = 1, size(keys)
        select case (keys(ii)%key)
           case ("fortran")

               call get_value(table, keys(ii), ptr_fortran)
               if (.not.associated(ptr_fortran)) then
                  call fatal_error(error,'package_t: error retrieving fortran table from TOML table')
                  return
               end if

               call self%features%load_from_toml(ptr_fortran,error)
               if (allocated(error)) return

           case ("preprocess")

               call get_value(table, keys(ii), ptr_preprocess)
               if (.not.associated(ptr_preprocess)) then
                  call fatal_error(error,'package_t: error retrieving preprocess table from TOML table')
                  return
               end if

               call self%preprocess%load_from_toml(ptr_preprocess,error)
               if (allocated(error)) return

           case ("sources")

               call get_value(table, keys(ii), ptr_sources)
               if (.not.associated(ptr_sources)) then
                  call fatal_error(error,'package_t: error retrieving sources table from TOML table')
                  return
               end if

               !> Read all dependencies
               call ptr_sources%get_keys(src_keys)
               allocate(self%sources(size(src_keys)))

               do jj = 1, size(src_keys)
                   call get_value(ptr_sources, src_keys(jj), ptr)
                   call self%sources(jj)%load_from_toml(ptr, error)
                   if (allocated(error)) return
               end do

           case default
              cycle find_others
        end select
    end do find_others

end subroutine package_load_from_toml


!> Check that two model objects are equal
logical function model_is_same(this,that)
    class(fpm_model_t), intent(in) :: this
    class(serializable_t), intent(in) :: that

    type(fpm_model_t), pointer :: other

    integer :: ii

    model_is_same = .false.

    select type (other=>that)
       type is (fpm_model_t)

           if (.not.(this%package_name==other%package_name)) return
           if (.not.(allocated(this%packages).eqv.allocated(other%packages))) return
           if (allocated(this%packages)) then
               if (.not.(size(this%packages)==size(other%packages))) return
               do ii = 1, size(this%packages)
                   if (.not.(this%packages(ii)==other%packages(ii))) return
               end do
           end if

           if (.not.(this%compiler==other%compiler)) return
           if (.not.(this%archiver==other%archiver)) return
           if (.not.(this%fortran_compile_flags==other%fortran_compile_flags)) return
           if (.not.(this%c_compile_flags==other%c_compile_flags)) return
           if (.not.(this%cxx_compile_flags==other%cxx_compile_flags)) return
           if (.not.(this%link_flags==other%link_flags)) return
           if (.not.(this%build_prefix==other%build_prefix)) return
           if (.not.(this%include_dirs==other%include_dirs)) return
           if (.not.(this%link_libraries==other%link_libraries)) return
           if (.not.(this%external_modules==other%external_modules)) return
           if (.not.(this%deps==other%deps)) return
           if (.not.(this%include_tests.eqv.other%include_tests)) return
           if (.not.(this%enforce_module_names.eqv.other%enforce_module_names)) return
           if (.not.(this%module_prefix==other%module_prefix)) return

       class default
          ! Not the same type
          return
    end select

    !> All checks passed!
    model_is_same = .true.

end function model_is_same

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

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

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

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

    integer :: ierr, ii
    type(toml_table), pointer :: ptr,ptr_pkg
    character(27) :: unnamed

    call set_string(table, "package-name", self%package_name, error, 'fpm_model_t')
    if (allocated(error)) return

    call add_table(table, "compiler", ptr, error, 'fpm_model_t')
    if (allocated(error)) return
    call self%compiler%dump_to_toml(ptr, error)
    if (allocated(error)) return

    call add_table(table, "archiver", ptr, error, 'fpm_model_t')
    if (allocated(error)) return
    call self%archiver%dump_to_toml(ptr, error)
    if (allocated(error)) return

    call set_string(table, "fortran-flags", self%fortran_compile_flags, error, 'fpm_model_t')
    if (allocated(error)) return
    call set_string(table, "c-flags", self%c_compile_flags, error, 'fpm_model_t')
    if (allocated(error)) return
    call set_string(table, "cxx-flags", self%cxx_compile_flags, error, 'fpm_model_t')
    if (allocated(error)) return
    call set_string(table, "link-flags", self%link_flags, error, 'fpm_model_t')
    if (allocated(error)) return
    call set_string(table, "build-prefix", self%build_prefix, error, 'fpm_model_t')
    if (allocated(error)) return
    call set_list(table, "include-dirs", self%include_dirs, error)
    if (allocated(error)) return
    call set_list(table, "link-libraries", self%link_libraries, error)
    if (allocated(error)) return
    call set_list(table, "external-modules", self%external_modules, error)
    if (allocated(error)) return

    call set_value(table, "include-tests", self%include_tests, error, 'fpm_model_t')
    if (allocated(error)) return
    call set_value(table, "module-naming", self%enforce_module_names, error, 'fpm_model_t')
    if (allocated(error)) return
    call set_string(table, "module-prefix", self%module_prefix, error, 'fpm_model_t')
    if (allocated(error)) return

    call add_table(table, "deps", ptr, error, 'fpm_model_t')
    if (allocated(error)) return
    call self%deps%dump_to_toml(ptr, error)
    if (allocated(error)) return

    !> Array of packages (including the root package)
    if (allocated(self%packages)) then

           ! Create packages table
           call add_table(table, "packages", ptr_pkg)
           if (.not. associated(ptr_pkg)) then
              call fatal_error(error, "fpm_model_t cannot create dependency table ")
              return
           end if

           do ii = 1, size(self%packages)

              associate (pkg => self%packages(ii))

                 !> Because dependencies are named, fallback if this has no name
                 !> So, serialization will work regardless of size(self%dep) == self%ndep
                 if (len_trim(pkg%name)==0) then
                    write(unnamed,1) ii
                    call add_table(ptr_pkg, trim(unnamed), ptr, error, 'fpm_model_t[package]')
                 else
                    call add_table(ptr_pkg, pkg%name, ptr, error, 'fpm_model_t[package]')
                 end if
                 if (allocated(error)) return
                 call pkg%dump_to_toml(ptr, error)
                 if (allocated(error)) return

              end associate

           end do
    end if

    1 format('UNNAMED_PACKAGE_',i0)

end subroutine model_dump_to_toml

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

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

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

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

    type(toml_key), allocatable :: keys(:),pkg_keys(:)
    integer :: ierr, ii, jj
    type(toml_table), pointer :: ptr,ptr_pkg

    call table%get_keys(keys)

    call get_value(table, "package-name", self%package_name)
    call get_value(table, "fortran-flags", self%fortran_compile_flags)
    call get_value(table, "c-flags", self%c_compile_flags)
    call get_value(table, "cxx-flags", self%cxx_compile_flags)
    call get_value(table, "link-flags", self%link_flags)
    call get_value(table, "build-prefix", self%build_prefix)

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

       select case (keys(ii)%key)
          case ("compiler")

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

               call self%compiler%load_from_toml(ptr, error)
               if (allocated(error)) return

          case ("archiver")

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

               call self%archiver%load_from_toml(ptr, error)
               if (allocated(error)) return

          case ("deps")

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

               call self%deps%load_from_toml(ptr, error)
               if (allocated(error)) return

          case ("packages")

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

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

               do jj = 1, size(pkg_keys)

                   call get_value(ptr, pkg_keys(jj), ptr_pkg)
                   call self%packages(jj)%load_from_toml(ptr_pkg, error)
                   if (allocated(error)) return

               end do


          case default
                cycle sub_deps
       end select

    end do sub_deps

    call get_list(table, "include-dirs", self%include_dirs, error)
    if (allocated(error)) return
    call get_list(table, "link-libraries", self%link_libraries, error)
    if (allocated(error)) return
    call get_list(table, "external-modules", self%external_modules, error)
    if (allocated(error)) return
    call get_value(table, "include-tests", self%include_tests, error, 'fpm_model_t')
    if (allocated(error)) return
    call get_value(table, "module-naming", self%enforce_module_names, error, 'fpm_model_t')
    if (allocated(error)) return
    call get_value(table, "module-prefix", self%module_prefix%s)

end subroutine model_load_from_toml

end module fpm_model