preprocess_config_t: make serializable and test

Author: perazz

src/fpm/manifest/fortran.f90

@@ -25,7 +25,6 @@ module fpm_manifest_fortran
             procedure :: dump_to_toml
             procedure :: load_from_toml
 
-
     end type fortran_config_t
 
     character(len=*), parameter, private :: class_name = 'fortran_config_t'

src/fpm/manifest/install.f90

@@ -31,7 +31,7 @@ module fpm_manifest_install
 
   end type install_config_t
 
-  character(*), parameter :: class_name = 'install_config_t'
+  character(*), parameter, private :: class_name = 'install_config_t'
 
 contains
 

src/fpm/manifest/preprocess.f90

@@ -12,15 +12,16 @@
 
 module fpm_manifest_preprocess
    use fpm_error, only : error_t, syntax_error
-   use fpm_strings, only : string_t
-   use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, get_list
+   use fpm_strings, only : string_t, operator(==)
+   use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, get_list, serializable_t, set_value, set_list, &
+                        set_string
    implicit none
    private
 
    public :: preprocess_config_t, new_preprocess_config, new_preprocessors
 
    !> Configuration meta data for a preprocessor
-   type :: preprocess_config_t
+   type, extends(serializable_t) :: preprocess_config_t
 
       !> Name of the preprocessor
       character(len=:), allocatable :: name
@@ -39,8 +40,15 @@ module fpm_manifest_preprocess
       !> Print information on this instance
       procedure :: info
 
+      !> Serialization interface
+      procedure :: serializable_is_same => preprocess_is_same
+      procedure :: dump_to_toml
+      procedure :: load_from_toml
+
    end type preprocess_config_t
 
+   character(*), parameter, private :: class_name = 'preprocess_config_t'
+
 contains
 
    !> Construct a new preprocess configuration from TOML data structure
@@ -154,7 +162,7 @@ subroutine info(self, unit, verbosity)
          pr = 1
       end if
 
-      if (pr < 1) return 
+      if (pr < 1) return
 
       write(unit, fmt) "Preprocessor"
       if (allocated(self%name)) then
@@ -181,4 +189,75 @@ subroutine info(self, unit, verbosity)
 
    end subroutine info
 
+   logical function preprocess_is_same(this,that)
+      class(preprocess_config_t), intent(in) :: this
+      class(serializable_t), intent(in) :: that
+
+      preprocess_is_same = .false.
+
+      select type (other=>that)
+         type is (preprocess_config_t)
+            if (allocated(this%name).neqv.allocated(other%name)) return
+            if (allocated(this%name)) then
+                if (.not.(this%name==other%name)) return
+            endif
+            if (.not.(this%suffixes==other%suffixes)) return
+            if (.not.(this%directories==other%directories)) return
+            if (.not.(this%macros==other%macros)) return
+
+         class default
+            ! Not the same type
+            return
+      end select
+
+      !> All checks passed!
+      preprocess_is_same = .true.
+
+    end function preprocess_is_same
+
+    !> Dump install config to toml table
+    subroutine dump_to_toml(self, table, error)
+
+       !> Instance of the serializable object
+       class(preprocess_config_t), intent(inout) :: self
+
+       !> Data structure
+       type(toml_table), intent(inout) :: table
+
+       !> Error handling
+       type(error_t), allocatable, intent(out) :: error
+
+       call set_string(table, "name", self%name, error)
+       if (allocated(error)) return
+       call set_list(table, "suffixes", self%suffixes, error)
+       if (allocated(error)) return
+       call set_list(table, "directories", self%directories, error)
+       if (allocated(error)) return
+       call set_list(table, "macros", self%macros, error)
+       if (allocated(error)) return
+
+     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(preprocess_config_t), intent(inout) :: self
+
+        !> Data structure
+        type(toml_table), intent(inout) :: table
+
+        !> Error handling
+        type(error_t), allocatable, intent(out) :: error
+
+        call get_value(table, "name", self%name)
+        call get_list(table, "suffixes", self%suffixes, error)
+        if (allocated(error)) return
+        call get_list(table, "directories", self%directories, error)
+        if (allocated(error)) return
+        call get_list(table, "macros", self%macros, error)
+        if (allocated(error)) return
+
+     end subroutine load_from_toml
+
 end module fpm_manifest_preprocess

test/fpm_test/test_toml.f90

@@ -11,6 +11,7 @@ module test_toml
     use fpm_manifest_fortran
     use fpm_manifest_library
     use fpm_manifest_executable
+    use fpm_manifest_preprocess
     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, &
@@ -50,6 +51,8 @@ subroutine collect_toml(testsuite)
            & new_unittest("serialize-install-config", install_config_roundtrip), &
            & new_unittest("serialize-fortran-config", fortran_features_roundtrip), &
            & new_unittest("serialize-library-config", library_config_roundtrip), &
+           & new_unittest("serialize-executable-config", executable_config_roundtrip), &
+           & new_unittest("serialize-preprocess-config", preprocess_config_roundtrip), &
            & new_unittest("serialize-string-array", string_array_roundtrip), &
            & new_unittest("serialize-fortran-features", fft_roundtrip), &
            & new_unittest("serialize-fortran-invalid", fft_invalid, should_fail=.true.), &
@@ -1253,4 +1256,19 @@ subroutine executable_config_roundtrip(error)
 
     end subroutine executable_config_roundtrip
 
+
+    subroutine preprocess_config_roundtrip(error)
+
+        !> Error handling
+        type(error_t), allocatable, intent(out) :: error
+
+        type(preprocess_config_t) :: prep
+
+        prep%name = "preprocessor config"
+        prep%macros = [string_t('Whatever'),string_t('FPM_BOOTSTRAP')]
+
+        call prep%test_serialization('preprocess_config', error)
+
+    end subroutine preprocess_config_roundtrip
+
 end module test_toml