kill process

Author: perazz

src/stdlib_system.F90

@@ -13,6 +13,7 @@ module stdlib_system
 public :: is_running
 public :: update
 public :: wait
+public :: kill
 public :: elapsed
 public :: has_win32
 
@@ -116,6 +117,15 @@ module subroutine update_process_state(process)
     end subroutine update_process_state
 end interface update
 
+! Kill a process 
+interface kill
+    module subroutine process_kill(process, success)
+        type(process_type), intent(inout) :: process
+        ! Return a boolean flag for successful operation
+        logical, intent(out) :: success
+    end subroutine process_kill
+end interface kill    
+
 !! version: experimental
 !!
 interface sleep

src/stdlib_system_subprocess.F90

@@ -43,12 +43,18 @@ subroutine process_create(cmd, stdin_stream, stdin_file, stdout_file, stderr_fil
             integer(process_ID), intent(out)        :: pid
         end subroutine process_create
 
+        logical(c_bool) function process_system_kill(pid) bind(C, name='process_kill')
+            import c_bool, process_ID
+            implicit none
+            integer(process_ID), intent(in), value :: pid
+        end function process_system_kill
+        
         ! System implementation of a wait function
         subroutine process_wait(seconds) bind(C,name='process_wait')
             import c_float
             implicit none
             real(c_float), intent(in) :: seconds
-        end subroutine process_wait
+        end subroutine process_wait            
 
         ! Return path to the null device
         type(c_ptr) function process_null_device(len) bind(C,name='process_null_device')
@@ -280,7 +286,7 @@ module subroutine wait_for_completion(process, max_wait_time)
 
     end subroutine wait_for_completion
 
-    !> Update a process's state, and 
+    !> Update a process's state, and save it to the process variable
     module subroutine update_process_state(process)
         type(process_type), intent(inout) :: process
 
@@ -318,6 +324,39 @@ module subroutine update_process_state(process)
 
     end subroutine update_process_state
 
+    ! Kill a process 
+    module subroutine process_kill(process, success)
+        type(process_type), intent(inout) :: process
+        ! Return a boolean flag for successful operation
+        logical, intent(out) :: success
+        
+        integer(c_int) :: exit_code
+        logical(c_bool) :: running
+        
+        success = .true.
+        
+        ! No need to
+        if (process%completed) return
+        if (process%id == FORKED_PROCESS) return
+        
+        success = logical(process_system_kill(process%id))
+        
+        if (success) then 
+            
+            call process_query_status(process%id, wait=C_TRUE, is_running=running, exit_code=exit_code)
+            
+            process%completed = .not.running
+            
+            if (process%completed) then 
+               ! Process completed, may have returned an error code  
+               process%exit_code = exit_code
+               call save_completed_state(process,delete_files=.true.)                 
+            end if            
+            
+        end if
+        
+    end subroutine process_kill
+    
     subroutine save_completed_state(process,delete_files)
         type(process_type), intent(inout) :: process
         logical, intent(in) :: delete_files

src/stdlib_system_subprocess.c

@@ -12,6 +12,7 @@
 #include <unistd.h>
 #include <time.h>
 #include <errno.h>
+#include <signal.h>
 #endif // _WIN32
 
 // Typedefs
@@ -164,6 +165,33 @@ void process_query_status_windows(int pid, bool wait, bool* is_running, int* exi
     CloseHandle(hProcess);
 }
 
+// Kill a process on Windows by sending a PROCESS_TERMINATE signal. 
+// Return true if the operation succeeded, or false if it failed (process does not 
+// exist anymore, or we may not have the rights to kill the process).
+bool process_kill_windows(int pid) {
+    HANDLE hProcess;
+
+    // Open the process with terminate rights
+    hProcess = OpenProcess(PROCESS_TERMINATE, FALSE, pid);
+
+    if (hProcess == NULL) {
+        // Failed to open the process; return false
+        return false;
+    }
+
+    // Attempt to terminate the process
+    if (!TerminateProcess(hProcess, 1)) {
+        // Failed to terminate the process
+        CloseHandle(hProcess);
+        return false;
+    }
+
+    // Successfully terminated the process
+    CloseHandle(hProcess);
+    return true;
+}
+
+
 #else // _WIN32
 
 /////////////////////////////////////////////////////////////////////////////////////
@@ -208,6 +236,26 @@ void process_query_status_unix(int pid, bool wait, bool* is_running, int* exit_c
     }
 }
 
+// Kill a process by sending a SIGKILL signal. Return .true. if succeeded, or false if not. 
+// Killing process may fail due to unexistent process, or not enough rights to kill.
+bool process_kill_unix(int pid) {
+    // Send the SIGKILL signal to the process
+    if (kill(pid, SIGKILL) == 0) {
+        // Successfully sent the signal
+        return true;
+    }
+
+    // If `kill` fails, check if the process no longer exists
+    if (errno == ESRCH) {
+        // Process does not exist
+        return true; // Already "terminated"
+    }
+
+    // Other errors occurred
+    return false;
+}
+
+
 // On UNIX systems: just fork a new process. The command line will be executed from Fortran.
 void process_create_posix(stdlib_handle* handle, stdlib_pid* pid) 
 {
@@ -243,6 +291,16 @@ void process_query_status(int pid, bool wait, bool* is_running, int* exit_code)
 #endif // _WIN32
 }
 
+// Cross-platform interface: kill process by ID
+bool process_kill(int pid)
+{
+#ifdef _WIN32
+   return process_kill_windows(pid);
+#else
+   return process_kill_unix(pid);
+#endif // _WIN32
+}
+
 // Cross-platform interface: sleep(seconds)
 void process_wait(float seconds)
 {

test/system/test_subprocess.f90

@@ -1,6 +1,6 @@
 module test_subprocess
     use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test
-    use stdlib_system, only: process_type, run, is_running, wait, update, elapsed, has_win32
+    use stdlib_system, only: process_type, run, is_running, wait, update, elapsed, has_win32, kill
 
     implicit none
 
@@ -14,6 +14,7 @@ subroutine collect_suite(testsuite)
         testsuite = [ &
             new_unittest('test_run_synchronous', test_run_synchronous), &
             new_unittest('test_run_asynchronous', test_run_asynchronous), &
+            new_unittest('test_process_kill', test_process_kill), &
             new_unittest('test_process_state', test_process_state) &
         ]
     end subroutine collect_suite
@@ -59,6 +60,40 @@ subroutine test_run_asynchronous(error)
 
     end subroutine test_run_asynchronous
 
+    !> Test killing an asynchronous process
+    subroutine test_process_kill(error)
+        type(error_type), allocatable, intent(out) :: error
+        type(process_type) :: process
+        logical :: running, success
+
+        ! Start a long-running process asynchronously
+        if (has_win32()) then
+            process = run("ping -n 10 127.0.0.1", wait=.false.)
+        else
+            process = run("ping -c 10 127.0.0.1", wait=.false.)
+        endif
+
+        ! Ensure the process starts running
+        call check(error, .not. process%completed, "Process should not be completed immediately after starting")
+        if (allocated(error)) return
+
+        running = is_running(process)
+        call check(error, running, "Process should be running immediately after starting")
+        if (allocated(error)) return
+
+        ! Kill the process
+        call kill(process, success)
+        call check(error, success, "Failed to kill the process")
+        if (allocated(error)) return
+
+        ! Verify the process is no longer running
+        call check(error, .not. is_running(process), "Process should not be running after being killed")
+        if (allocated(error)) return
+
+        ! Ensure process state updates correctly after killing
+        call check(error, process%completed, "Process should be marked as completed after being killed")
+    end subroutine test_process_kill
+
     !> Test updating and checking process state
     subroutine test_process_state(error)
         type(error_type), allocatable, intent(out) :: error