register a compile command

Author: perazz

fpm.toml

@@ -21,7 +21,7 @@ fortran-regex.tag  = "1.1.2"
 jonquil.git = "https://github.com/toml-f/jonquil"
 jonquil.rev = "4fbd4cf34d577c0fd25e32667ee9e41bf231ece8"
 fortran-shlex.git = "https://github.com/perazz/fortran-shlex"
-fortran-shlex.tag = "1.0.1"
+fortran-shlex.tag = "1.2.1"
 
 [[test]]
 name = "cli-test"

src/fpm_compile_commands.F90

@@ -1,8 +1,10 @@
 !># Store compiler commands in a `compile_commands.json` table
 module fpm_compile_commands
-    use fpm_toml, only: serializable_t, set_string, set_list, get_value, get_list, toml_table
+    use fpm_toml, only: serializable_t, set_string, set_list, get_value, get_list, toml_table, add_table
     use fpm_strings, only: string_t, operator(==)
-    use fpm_error, only: error_t
+    use fpm_error, only: error_t, syntax_error, fatal_error
+    use fpm_os, only: get_current_directory
+    use shlex_module, only: shlex_split => split 
     implicit none
 
     !> Definition of a build command
@@ -25,11 +27,14 @@ module fpm_compile_commands
 
     type, extends(serializable_t) :: compile_command_table_t
 
-        
         type(compile_command_t), allocatable :: command(:)
 
         contains
 
+        !> Operation
+        procedure :: destroy              => cct_destroy
+        procedure :: register             => cct_register
+        
         !> Serialization interface
         procedure :: serializable_is_same => cct_is_same
         procedure :: dump_to_toml         => cct_dump_toml
@@ -145,7 +150,79 @@ subroutine cct_dump_toml(self, table, error)
         1 format('compile_command_',i0)
 
     end subroutine cct_dump_toml
+    
+    !> Cleanup a compile command table
+    elemental subroutine cct_destroy(self)
+
+        !> Instance of the serializable object
+        class(compile_command_table_t), intent(inout) :: self
+        
+        if (allocated(self%command)) deallocate(self%command)
+        
+    end subroutine cct_destroy
+    
+    !> Register a new compile command
+    subroutine cct_register(self, command, error)
 
+        !> Instance of the serializable object
+        class(compile_command_table_t), intent(inout) :: self
+
+        !> Data structure
+        character(len=*), intent(in) :: command
+        
+        !> Error handling
+        type(error_t), allocatable, intent(out) :: error    
+        
+        ! Local variables
+        type(compile_command_t) :: cmd
+        character(len=:), allocatable :: args(:), cwd, source_file
+        logical :: sh_success
+        integer :: i,n
+        
+        ! Early check
+        if (len_trim(command) <= 0) then
+            call syntax_error(error, "compile_command_table_t trying to register an empty command")
+            return
+        end if
+
+        ! Tokenize the input command into args(:)
+        args = shlex_split(command, join_spaced=.true., keep_quotes=.true., success=sh_success)
+        n = size(args)
+        
+        if (n==0 .or. .not.sh_success) then 
+            call syntax_error(error, "compile_command_table_t failed tokenizing: <"//command//">")
+            return
+        end if
+        
+        ! Get current working directory
+        call get_current_directory(cwd, error)
+        if (allocated(error)) return
+
+        ! Try to find the source file
+        allocate(character(len=0) :: source_file)
+        find_source_file: do i = 1, n-1
+            if (args(i) == "-c") then
+                source_file = args(i+1)
+                exit find_source_file
+            end if
+        end do find_source_file
+
+        ! Fallback: use last argument if not found
+        if (len_trim(source_file)==0) source_file = args(n)
+
+        ! Fill in the compile_command_t
+        cmd = compile_command_t(directory = string_t(cwd), &
+                                arguments = [(string_t(trim(args(i))), i=1,n)], &
+                                file = string_t(source_file))
+        
+        if (allocated(self%command)) then         
+           self%command = [self%command, cmd]
+        else
+           allocate(self%command(1), source=cmd) 
+        end if
+
+    end subroutine cct_register
+        
     !> Read compile_command_table_t from toml table (no checks made at this stage)
     subroutine cct_load_toml(self, table, error)