implement compile_command_table_t

Author: perazz

src/fpm_compile_commands.F90

@@ -16,13 +16,26 @@ module fpm_compile_commands
 
         contains
 
-        !> Serialization procedures
+        !> Serialization interface
         procedure :: serializable_is_same => compile_command_is_same
         procedure :: dump_to_toml         => compile_command_dump_toml
         procedure :: load_from_toml       => compile_command_load_toml
 
     end type compile_command_t    
 
+    type, extends(serializable_t) :: compile_command_table_t
+        
+        type(compile_command_t), allocatable :: command(:)
+        
+        contains
+        
+        !> Serialization interface
+        procedure :: serializable_is_same => cct_is_same
+        procedure :: dump_to_toml         => cct_dump_toml
+        procedure :: load_from_toml       => cct_load_toml
+        
+        
+    end type compile_command_table_t    
 
     contains
 
@@ -92,5 +105,78 @@ logical function compile_command_is_same(this,that)
 
     end function compile_command_is_same
 
+    !> Dump compile_command_table_t to toml table
+    subroutine cct_dump_toml(self, table, error)
+
+        !> Instance of the serializable object
+        class(compile_command_table_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, "directory", self%directory, error, 'compile_command_table_t')
+!        if (allocated(error)) return
+!        call set_list(table, "arguments", self%arguments, error)
+!        if (allocated(error)) return
+!        call set_string(table, "file", self%file, error, 'compile_command_table_t')
+!        if (allocated(error)) return    
+
+    end subroutine cct_dump_toml
+
+    !> Read compile_command_table_t from toml table (no checks made at this stage)
+    subroutine cct_load_toml(self, table, error)
+
+        !> Instance of the serializable object
+        class(compile_command_table_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, "directory", self%directory, error, 'compile_command_table_t')
+!        if (allocated(error)) return
+!        call get_list(table, "arguments", self%arguments, error)
+!        if (allocated(error)) return   
+!        call get_value(table, "file", self%file, error, 'compile_command_table_t')
+!        if (allocated(error)) return
+
+    end subroutine cct_load_toml
+
+    !> Check that two compile_command_table_t objects are equal
+    logical function cct_is_same(this,that)
+        class(compile_command_table_t), intent(in) :: this
+        class(serializable_t), intent(in) :: that
+        
+        integer :: i
+
+        cct_is_same = .false.
+
+        select type (other=>that)
+           type is (compile_command_table_t)
+            
+              if (allocated(this%command).neqv.allocated(other%command)) return 
+              if (allocated(this%command)) then
+                  if (.not.(size  (this%command)  ==size  (other%command))) return
+                  if (.not.(ubound(this%command,1)==ubound(other%command,1))) return
+                  if (.not.(lbound(this%command,1)==lbound(other%command,1))) return
+                  do i=lbound(this%command,1),ubound(this%command,1)
+                     if (.not.this%command(i)==other%command(i)) return
+                  end do
+              end if
+
+           class default
+              ! Not the same type
+              return
+        end select
+
+        !> All checks passed!
+        cct_is_same = .true.
+
+    end function cct_is_same        
 
 end module fpm_compile_commands