serialize file_scope_flag and test

Author: perazz

src/fpm/manifest/profiles.f90

@@ -43,7 +43,7 @@
 !>
 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
+    use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, serializable_t, set_value, set_string
     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
@@ -53,19 +53,26 @@ module fpm_manifest_profile
             & info_profile, find_profile, DEFAULT_COMPILER
 
     !> Name of the default compiler
-    character(len=*), parameter :: DEFAULT_COMPILER = 'gfortran' 
+    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 :: file_scope_flag
+    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
@@ -78,7 +85,7 @@ module fpm_manifest_profile
 
       !> Value repesenting OS
       integer :: os_type
-      
+
       !> Fortran compiler flags
       character(len=:), allocatable :: flags
 
@@ -110,16 +117,16 @@ module fpm_manifest_profile
       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
 
@@ -190,7 +197,7 @@ subroutine validate_compiler_name(compiler_name, is_valid)
             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)
 
@@ -373,10 +380,10 @@ subroutine get_flags(profile_name, compiler_name, os_type, key_list, table, prof
                  & 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
 
@@ -447,7 +454,7 @@ 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
 
@@ -468,7 +475,7 @@ subroutine traverse_oss(profile_name, compiler_name, os_list, table, profiles, p
 
         !> 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
@@ -513,7 +520,7 @@ 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
 
@@ -522,10 +529,10 @@ subroutine traverse_compilers(profile_name, comp_list, table, error, profiles_si
 
         !> 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
 
@@ -534,8 +541,8 @@ subroutine traverse_compilers(profile_name, comp_list, table, error, profiles_si
 
         !> Index in the list of profiles
         integer, intent(inout), optional :: profindex
-        
-        character(len=:), allocatable :: compiler_name        
+
+        character(len=:), allocatable :: compiler_name
         type(toml_table), pointer :: comp_node
         type(toml_key), allocatable :: os_list(:)
         integer :: icomp, stat
@@ -544,7 +551,7 @@ subroutine traverse_compilers(profile_name, comp_list, table, error, profiles_si
         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  
+          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
@@ -567,7 +574,7 @@ subroutine traverse_compilers(profile_name, comp_list, table, error, profiles_si
           else
             call fatal_error(error,'*traverse_compilers*:Error: Compiler name not specified or invalid.')
           end if
-        end do        
+        end do
       end subroutine traverse_compilers
 
       !> Construct new profiles array from a TOML data structure
@@ -596,9 +603,9 @@ subroutine new_profiles(profiles, table, error)
         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)
@@ -633,7 +640,7 @@ subroutine new_profiles(profiles, table, error)
 
         profiles_size = profiles_size + size(default_profiles)
         allocate(profiles(profiles_size))
-        
+
         do profindex=1, size(default_profiles)
           profiles(profindex) = default_profiles(profindex)
         end do
@@ -954,4 +961,71 @@ subroutine find_profile(profiles, profile_name, compiler, os_type, found_matchin
           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
+
+
+
 end module fpm_manifest_profile

test/fpm_test/test_toml.f90

@@ -12,6 +12,7 @@ module test_toml
     use fpm_manifest_library
     use fpm_manifest_executable
     use fpm_manifest_preprocess
+    use fpm_manifest_profile
     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, &
@@ -53,6 +54,7 @@ subroutine collect_toml(testsuite)
            & 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-file-scope-flag", file_scope_flag_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.), &
@@ -1271,4 +1273,21 @@ subroutine preprocess_config_roundtrip(error)
 
     end subroutine preprocess_config_roundtrip
 
+    subroutine file_scope_flag_roundtrip(error)
+
+        !> Error handling
+        type(error_t), allocatable, intent(out) :: error
+
+        type(file_scope_flag) :: ff
+
+        call ff%test_serialization('file_scope_flag: empty', error)
+        if (allocated(error)) return
+
+        ff%file_name = "preprocessor config"
+        ff%flags = "-1 -f -2 -g"
+
+        call ff%test_serialization('file_scope_flag: non-empty', error)
+
+    end subroutine file_scope_flag_roundtrip
+
 end module test_toml