cct_dump_toml Subroutine

public subroutine cct_dump_toml(self, table, error)

Dump compile_command_table_t to toml table

Type Bound

compile_command_table_t

Arguments

Type IntentOptional Attributes Name
class(compile_command_table_t), intent(inout) :: self

Instance of the serializable object

type(toml_table), intent(inout) :: table

Data structure

type(error_t), intent(out), allocatable :: error

Error handling


Variables

Type Visibility Attributes Name Initial
type(toml_array), public, pointer :: array
integer, public :: ii
integer, public :: stat

Source Code

    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
        
        integer :: stat, ii
        type(toml_array), pointer :: array
        
        ! Create array
        call add_array(table, 'compile_commands', array, stat=stat)
        if (stat/=toml_stat%success .or. .not.associated(array)) then 
            call fatal_error(error,"compile_command_table_t cannot create entry")
            return
        end if
        
        ! Dump to it
        call cct_dump_array(self, array, error)

    end subroutine cct_dump_toml