serialize executable_config_t

Author: perazz

src/fpm/manifest/dependency.f90

@@ -35,7 +35,7 @@ module fpm_manifest_dependency
     private
 
     public :: dependency_config_t, new_dependency, new_dependencies, manifest_has_changed, &
-        & dependency_destroy
+        & dependency_destroy, resize
 
     !> Configuration meta data for a dependency
     type, extends(serializable_t) :: dependency_config_t
@@ -73,6 +73,10 @@ module fpm_manifest_dependency
     !> Common output format for writing to the command line
     character(len=*), parameter :: out_fmt = '("#", *(1x, g0))'
 
+    interface resize
+        module procedure resize_dependency_config
+    end interface resize
+
 contains
 
     !> Construct a new dependency configuration from a TOML data structure
@@ -438,4 +442,39 @@ subroutine load_from_toml(self, table, error)
 
     end subroutine load_from_toml
 
+    !> Reallocate a list of dependencies
+    pure subroutine resize_dependency_config(var, n)
+        !> Instance of the array to be resized
+        type(dependency_config_t), allocatable, intent(inout) :: var(:)
+        !> Dimension of the final array size
+        integer, intent(in), optional :: n
+
+        type(dependency_config_t), allocatable :: tmp(:)
+        integer :: this_size, new_size
+        integer, parameter :: initial_size = 16
+
+        if (allocated(var)) then
+          this_size = size(var, 1)
+          call move_alloc(var, tmp)
+        else
+          this_size = initial_size
+        end if
+
+        if (present(n)) then
+          new_size = n
+        else
+          new_size = this_size + this_size/2 + 1
+        end if
+
+        allocate (var(new_size))
+
+        if (allocated(tmp)) then
+          this_size = min(size(tmp, 1), size(var, 1))
+          var(:this_size) = tmp(:this_size)
+          deallocate (tmp)
+        end if
+
+    end subroutine resize_dependency_config
+
+
 end module fpm_manifest_dependency

src/fpm/manifest/executable.f90

@@ -11,18 +11,19 @@
 !>[executable.dependencies]
 !>```
 module fpm_manifest_executable
-    use fpm_manifest_dependency, only : dependency_config_t, new_dependencies
-    use fpm_error, only : error_t, syntax_error, bad_name_error
-    use fpm_strings, only : string_t
-    use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, get_list
+    use fpm_manifest_dependency, only : dependency_config_t, new_dependencies, resize
+    use fpm_error, only : error_t, syntax_error, bad_name_error, fatal_error
+    use fpm_strings, only : string_t, operator(==)
+    use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, get_list, serializable_t, add_table, &
+                          set_string, set_list
     implicit none
     private
 
     public :: executable_config_t, new_executable
 
 
     !> Configuation meta data for an executable
-    type :: executable_config_t
+    type, extends(serializable_t) :: executable_config_t
 
         !> Name of the resulting executable
         character(len=:), allocatable :: name
@@ -44,8 +45,15 @@ module fpm_manifest_executable
         !> Print information on this instance
         procedure :: info
 
+        !> Serialization interface
+        procedure :: serializable_is_same => exe_is_same
+        procedure :: dump_to_toml
+        procedure :: load_from_toml
+
     end type executable_config_t
 
+    character(*), parameter, private :: class_name = 'executable_config_t'
+
 
 contains
 
@@ -186,4 +194,156 @@ subroutine info(self, unit, verbosity)
     end subroutine info
 
 
+    logical function exe_is_same(this,that)
+        class(executable_config_t), intent(in) :: this
+        class(serializable_t), intent(in) :: that
+
+        integer :: ii
+
+        exe_is_same = .false.
+
+        select type (other=>that)
+           type is (executable_config_t)
+              if (.not.this%link==other%link) return
+              if (.not.allocated(this%name).eqv.allocated(other%name)) return
+              if (.not.this%name==other%name) return
+              if (.not.allocated(this%source_dir).eqv.allocated(other%source_dir)) return
+              if (.not.this%source_dir==other%source_dir) return
+              if (.not.allocated(this%main).eqv.allocated(other%main)) return
+              if (.not.this%main==other%main) return
+              if (.not.allocated(this%dependency).eqv.allocated(other%dependency)) return
+              if (allocated(this%dependency)) then
+                 if (.not.(size(this%dependency)==size(other%dependency))) return
+                 do ii = 1, size(this%dependency)
+                    if (.not.(this%dependency(ii)==other%dependency(ii))) return
+                 end do
+              end if
+           class default
+              ! Not the same type
+              return
+        end select
+
+        !> All checks passed!
+        exe_is_same = .true.
+
+    end function exe_is_same
+
+    !> Dump install config to toml table
+    subroutine dump_to_toml(self, table, error)
+
+        !> Instance of the serializable object
+        class(executable_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(27) :: unnamed
+
+        call set_string(table, "name", self%name, error)
+        if (allocated(error)) return
+        call set_string(table, "source-dir", self%source_dir, error)
+        if (allocated(error)) return
+        call set_string(table, "main", self%main, error)
+        if (allocated(error)) return
+
+        if (allocated(self%dependency)) then
+
+           ! Create dependency table
+           call add_table(table, "dependencies", ptr_deps)
+           if (.not. associated(ptr_deps)) then
+              call fatal_error(error, class_name//" cannot create dependency table ")
+              return
+           end if
+
+           do ii = 1, size(self%dependency)
+              associate (dep => self%dependency(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(dep%name)==0) then
+                    write(unnamed,1) ii
+                    call add_table(ptr_deps, trim(unnamed), ptr)
+                 else
+                    call add_table(ptr_deps, dep%name, ptr)
+                 end if
+                 if (.not. associated(ptr)) then
+                    call fatal_error(error, class_name//" cannot create entry for dependency "//dep%name)
+                    return
+                 end if
+                 call dep%dump_to_toml(ptr, error)
+                 if (allocated(error)) return
+              end associate
+           end do
+
+        endif
+
+        call set_list(table, "link", self%link, error)
+        if (allocated(error)) return
+
+        1 format('UNNAMED_DEPENDENCY_',i0)
+
+    end subroutine dump_to_toml
+
+    !> Read install config from toml table (no checks made at this stage)
+    subroutine load_from_toml(self, table, error)
+
+        !> Instance of the serializable object
+        class(executable_config_t), intent(inout) :: self
+
+        !> Data structure
+        type(toml_table), intent(inout) :: table
+
+        !> Error handling
+        type(error_t), allocatable, intent(out) :: error
+
+        !> Local variables
+        type(toml_key), allocatable :: keys(:),dep_keys(:)
+        type(toml_table), pointer :: ptr_deps,ptr
+        integer :: ii, jj, ierr
+
+        call table%get_keys(keys)
+
+        call get_value(table, "name", self%name)
+        if (allocated(error)) return
+        call get_value(table, "source-dir", self%source_dir)
+        if (allocated(error)) return
+        call get_value(table, "main", self%main)
+        if (allocated(error)) return
+        call get_list(table, "link", self%link, error)
+
+        find_deps_table: do ii = 1, size(keys)
+            if (keys(ii)%key=="dependencies") then
+
+               call get_value(table, keys(ii), ptr_deps)
+               if (.not.associated(ptr_deps)) then
+                  call fatal_error(error,class_name//': error retrieving dependency table from TOML table')
+                  return
+               end if
+
+               !> Read all dependencies
+               call ptr_deps%get_keys(dep_keys)
+               call resize(self%dependency, size(dep_keys))
+
+               do jj = 1, size(dep_keys)
+
+                   call get_value(ptr_deps, dep_keys(jj), ptr)
+                   call self%dependency(jj)%load_from_toml(ptr, error)
+                   if (allocated(error)) return
+
+               end do
+
+               exit find_deps_table
+
+            endif
+        end do find_deps_table
+
+    end subroutine load_from_toml
+
+
 end module fpm_manifest_executable

test/fpm_test/test_toml.f90

@@ -10,6 +10,7 @@ module test_toml
     use fpm_manifest_install
     use fpm_manifest_fortran
     use fpm_manifest_library
+    use fpm_manifest_executable
     use fpm_versioning, only: new_version
     use fpm_strings, only: string_t, operator(==), split
     use fpm_model, only: fortran_features_t, package_t, FPM_SCOPE_LIB, FPM_UNIT_MODULE, fpm_model_t, &
@@ -1212,4 +1213,44 @@ subroutine library_config_roundtrip(error)
 
     end subroutine library_config_roundtrip
 
+
+    subroutine executable_config_roundtrip(error)
+
+        !> Error handling
+        type(error_t), allocatable, intent(out) :: error
+
+        type(executable_config_t) :: exe
+        type(dependency_config_t) :: dep
+
+        exe%name = "my_executable"
+        exe%source_dir = 'app'
+
+        call exe%test_serialization('executable_config: 1',error)
+        if (allocated(error)) return
+
+        exe%main = 'main_program.F90'
+
+        call exe%test_serialization('executable_config: 2',error)
+        if (allocated(error)) return
+
+        exe%link = [string_t('netcdf'),string_t('hdf5')]
+        call exe%test_serialization('executable_config: 3',error)
+
+        call dependency_destroy(dep)
+
+        dep%name = "M_CLI2"
+        dep%path = "~/./some/dummy/path"
+        dep%namespace = "urbanjost"
+        allocate(dep%requested_version)
+        call new_version(dep%requested_version, "3.2.0",error); if (allocated(error)) return
+
+        allocate(dep%git)
+        dep%git = git_target_revision(url="https://github.com/urbanjost/M_CLI2.git", &
+                                      sha1="7264878cdb1baff7323cc48596d829ccfe7751b8")
+
+        allocate(exe%dependency(1),source=dep)
+        call exe%test_serialization('executable_config: 4',error)
+
+    end subroutine executable_config_roundtrip
+
 end module test_toml