system: subprocessing interface (#911)

Author: perazz

CMakeLists.txt

@@ -4,7 +4,7 @@ cmake_minimum_required(VERSION 3.14.0)
 set(CMAKE_USER_MAKE_RULES_OVERRIDE ${CMAKE_CURRENT_SOURCE_DIR}/config/DefaultFlags.cmake)
 
 project(fortran_stdlib
-        LANGUAGES Fortran
+	LANGUAGES Fortran C
         DESCRIPTION "Community driven and agreed upon de facto standard library for Fortran"
 )
 

config/fypp_deployment.py

@@ -105,7 +105,7 @@ def recursive_copy(folder):
         for root, _, files in os.walk(folder):
             for file in files:
                 if file not in prune:
-                    if file.endswith(".f90") or file.endswith(".F90") or file.endswith(".dat") or file.endswith(".npy"):
+                    if file.endswith((".f90", ".F90", ".dat", ".npy", ".c")):
                         shutil.copy2(os.path.join(root, file), base_folder+os.sep+folder+os.sep+file)
     recursive_copy('src')
     recursive_copy('test')

doc/specs/index.md

@@ -38,6 +38,7 @@ This is an index/directory of the specifications (specs) for each new module/fea
  - [string\_type](./stdlib_string_type.html) - Basic string support
  - [stringlist_type](./stdlib_stringlist_type.html) - 1-Dimensional list of strings
  - [strings](./stdlib_strings.html) - String handling and manipulation routines
+ - [system](./stdlib_system.html) - OS and sub-processing routines
  - [version](./stdlib_version.html) - Version information
 
 ## Released/Stable Features & Modules

doc/specs/stdlib_strings.md

@@ -498,6 +498,7 @@ The result is of the same type as the elements of `strings` (`type(string_type)`
 ```
 
 <!-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->
+
 ### `to_string`
 
 #### Description

doc/specs/stdlib_system.md

@@ -0,0 +1,337 @@
+---
+title: system
+---
+
+# System and sub-processing module
+
+The `stdlib_system` module provides interface for interacting with external processes, enabling the execution 
+and monitoring of system commands or applications directly from Fortran. 
+
+[TOC]
+
+## `run` - Execute an external process synchronously
+
+### Status
+
+Experimental
+
+### Description
+
+The `run` interface allows execution of external processes using a single command string or a list of arguments.  
+Processes run synchronously, meaning execution is blocked until the process finishes.  
+Optional arguments enable the collection of standard output and error streams, as well as sending input via standard input. 
+Additionally, a callback function can be specified to execute upon process completion, optionally receiving a user-defined payload.
+
+### Syntax
+
+`process = ` [[stdlib_subprocess(module):run(interface)]] `(args [, stdin] [, want_stdout] [, want_stderr] [, callback] [, payload])`
+
+### Arguments
+
+`args`: Shall be a `character(*)` string (for command-line execution) or a `character(*), dimension(:)` array (for argument-based execution). It specifies the command and arguments to execute. This is an `intent(in)` argument.
+
+`stdin` (optional): Shall be a `character(*)` value containing input to send to the process via standard input (pipe). This is an `intent(in)` argument.
+
+`want_stdout` (optional): Shall be a `logical` flag. If `.true.`, the standard output of the process will be captured; if `.false.` (default), it will be lost. This is an `intent(in)` argument.
+
+`want_stderr` (optional): Shall be a `logical` flag. If `.true.`, the standard error output of the process will be captured. If `.false.` (default), it will be lost. This is an `intent(in)` argument.
+
+`callback` (optional): Shall be a procedure conforming to the `process_callback` interface. If present, this function will be called upon process completion with the process ID, exit state, and optionally collected standard input, output, and error streams. This is an `intent(in)` argument.
+
+`payload` (optional): Shall be a generic (`class(*)`) scalar that will be passed to the callback function upon process completion. It allows users to associate custom data with the process execution. This is an `intent(inout), target` argument.
+
+### Return Value
+
+Returns an object of type `process_type` that contains information about the state of the created process.
+
+### Example
+
+```fortran
+! Example usage with command line or list of arguments
+type(process_type) :: p
+
+! Run a simple command line synchronously
+p = run("echo 'Hello, world!'", want_stdout=.true.)
+```
+
+## `runasync` - Execute an external process asynchronously
+
+### Status
+
+Experimental
+
+### Description
+
+The `runasync` interface allows execution of external processes using a single command string or a list of arguments.  
+Processes are run asynchronously (non-blocking), meaning execution does not wait for the process to finish.  
+Optional arguments enable the collection of standard output and error streams, as well as sending input via standard input.
+Additionally, a callback function can be specified to execute upon process completion, optionally receiving a user-defined payload.
+
+### Syntax
+
+`process = ` [[stdlib_subprocess(module):runasync(interface)]] `(args [, stdin] [, want_stdout] [, want_stderr] [, callback] [, payload])`
+
+### Arguments
+
+`args`: Shall be a `character(*)` string (for command-line execution) or a `character(*), dimension(:)` array (for argument-based execution). It specifies the command and arguments to execute. This is an `intent(in)` argument.
+
+`stdin` (optional): Shall be a `character(*)` value containing input to send to the process via standard input (pipe). This is an `intent(in)` argument.
+
+`want_stdout` (optional): Shall be a `logical` flag. If `.true.`, the standard output of the process will be captured; if `.false.` (default), it will be lost. This is an `intent(in)` argument.
+
+`want_stderr` (optional): Shall be a `logical` flag. If `.true.`, the standard error output of the process will be captured. Default: `.false.`. This is an `intent(in)` argument.
+
+`callback` (optional): Shall be a procedure conforming to the `process_callback` interface. If present, this function will be called upon process completion with the process ID, exit state, and optionally collected standard input, output, and error streams. This is an `intent(in)` argument.
+
+`payload` (optional): Shall be a generic (`class(*)`) scalar that will be passed to the callback function upon process completion. It allows users to associate custom data with the process execution. This is an `intent(inout), target` argument.
+
+### Return Value
+
+Returns an object of type `process_type` that contains information about the state of the created process.
+
+### Example
+
+```fortran
+{!example/system/example_process_1.f90!}
+```
+
+## `is_running` - Check if a process is still running
+
+### Status
+
+Experimental
+
+### Description
+
+The `is_running` interface provides a method to check if an external process is still running.  
+This is useful for monitoring the status of asynchronous processes created with the `run` interface.
+
+### Syntax
+
+`status = ` [[stdlib_subprocess(module):is_running(interface)]] `(process)`
+
+### Arguments
+
+`process`:  Shall be a `type(process_type)` object representing the external process to check. This is an `intent(inout)` argument.
+
+
+### Return Value
+
+Returns a `logical` value: `.true.` if the process is still running, or `.false.` if the process has terminated.
+After a call to `is_running`, the `type(process_type)` structure is also updated to the latest process state.
+
+### Example
+
+```fortran
+{!example/system/example_process_2.f90!}
+```
+
+## `is_completed` - Check if a process has completed execution
+
+### Status
+
+Experimental
+
+### Description
+
+The `is_completed` interface provides a method to check if an external process has finished execution.  
+This is useful for determining whether asynchronous processes created with the `run` interface have terminated.
+
+### Syntax
+
+`status = ` [[stdlib_subprocess(module):is_completed(interface)]] `(process)`
+
+### Arguments
+
+`process`: Shall be a `type(process_type)` object representing the external process to check. This is an `intent(inout)` argument.
+
+### Return Value
+
+Returns a `logical` value:  
+- `.true.` if the process has completed.  
+- `.false.` if the process is still running.  
+
+After a call to `is_completed`, the `type(process_type)` structure is updated to reflect the latest process state.
+
+### Example
+
+```fortran
+{!example/system/example_process_1.f90!}
+```
+
+## `elapsed` - Return process lifetime in seconds
+
+### Status
+
+Experimental
+
+### Description
+
+The `elapsed` interface provides a method to calculate the total time that has elapsed since a process was started.  
+This is useful for tracking the duration of an external process or for performance monitoring purposes.  
+
+The result is a real value representing the elapsed time in seconds, measured from the time the process was created.
+
+### Syntax
+
+`delta_t = ` [[stdlib_subprocess(module):elapsed(subroutine)]] `(process)`
+
+### Arguments
+
+`process`: Shall be a `type(process_type)` object representing the external process. It is an `intent(in)` argument.
+
+### Return Value
+
+Returns a `real(real64)` value that represents the elapsed time (in seconds) since the process was started.  
+If the process is still running, the value returned is the time elapsed until the call to this function. 
+Otherwise, the total process duration from creation until completion is returned.
+
+### Example
+
+```fortran
+{!example/system/example_process_3.f90!}
+```
+
+## `wait` - Wait until a running process is completed
+
+### Status
+
+Experimental
+
+### Description
+
+The `wait` interface provides a method to block the calling program until the specified process completes.  
+If the process is running asynchronously, this subroutine will pause the workflow until the given process finishes.  
+Additionally, an optional maximum wait time can be provided. If the process does not finish within the specified time, 
+the subroutine will return without waiting further.
+
+On return from this routine, the process state is accordingly updated.
+This is useful when you want to wait for a background task to complete, but want to avoid indefinite blocking 
+in case of process hang or delay.
+
+
+### Syntax
+
+`call ` [[stdlib_subprocess(module):wait(subroutine)]] `(process [, max_wait_time])`
+
+### Arguments
+
+`process`: Shall be a `type(process_type)` object representing the external process to monitor.  
+This is an `intent(inout)` argument, and its state is updated upon completion.
+
+`max_wait_time` (optional): Shall be a `real` value specifying the maximum wait time in seconds.  
+If not provided, the subroutine will wait indefinitely until the process completes.
+
+### Example
+
+```fortran
+{!example/system/example_process_2.f90!}
+```
+
+## `update` - Update the internal state of a process
+
+### Status
+
+Experimental
+
+### Description
+
+The `update` interface allows the internal state of a process object to be updated by querying the system.  
+After the process completes, the standard output and standard error are retrieved, if they were requested, and loaded into the `process%stdout` and `process%stderr` string variables, respectively.
+
+This is especially useful for monitoring asynchronous processes and retrieving their output after they have finished.
+
+### Syntax
+
+`call ` [[stdlib_subprocess(module):update(subroutine)]] `(process)`
+
+### Arguments
+
+`process`: Shall be a `type(process_type)` object representing the external process whose state needs to be updated.  
+This is an `intent(inout)` argument, and its internal state is updated on completion.
+
+### Example
+
+```fortran
+{!example/system/example_process_5.f90!}
+```
+
+## `kill` - Terminate a running process
+
+### Status
+
+Experimental
+
+### Description
+
+The `kill` interface is used to terminate a running external process. It attempts to stop the process and returns a boolean flag indicating whether the operation was successful.
+This interface is useful when a process needs to be forcefully stopped, for example, if it becomes unresponsive or if its execution is no longer required.
+
+### Syntax
+
+`call ` [[stdlib_subprocess(module):kill(subroutine)]] `(process, success)`
+
+### Arguments
+
+`process`: Shall be a `type(process_type)` object representing the external process to be terminated.  
+This is an `intent(inout)` argument, and on return is updated with the terminated process state.
+
+`success`: Shall be a `logical` variable. It is set to `.true.` if the process was successfully killed, or `.false.` otherwise.
+
+### Example
+
+```fortran
+{!example/system/example_process_4.f90!}
+```
+
+## `sleep` - Pause execution for a specified time in milliseconds
+
+### Status
+
+Experimental
+
+### Description
+
+The `sleep` interface pauses the execution of a program for a specified duration, given in milliseconds. 
+This routine acts as a cross-platform wrapper, abstracting the underlying platform-specific sleep implementations. 
+It ensures that the requested sleep duration is honored on both Windows and Unix-like systems.
+
+### Syntax
+
+`call ` [[stdlib_system(module):sleep(subroutine)]] `(millisec)`
+
+### Arguments
+
+`millisec`: Shall be an `integer` representing the number of milliseconds to sleep. This is an `intent(in)` argument.
+
+### Example
+
+```fortran
+{!example/system/example_sleep.f90!}
+```
+
+## `is_windows` - Check if the system is running on Windows
+
+### Status
+
+Experimental
+
+### Description
+
+The `is_windows` interface provides a quick, compile-time check to determine if the current system is Windows. 
+It leverages a C function that checks for the presence of the `_WIN32` macro, which is defined in C compilers when targeting Windows. 
+This function is highly efficient and works during the compilation phase, avoiding the need for runtime checks.
+
+### Syntax
+
+`result = ` [[stdlib_system(module):is_windows(function)]] `()`
+
+### Return Value
+
+Returns a `logical` flag: `.true.` if the system is Windows, or `.false.` otherwise.
+
+### Example
+
+```fortran
+{!example/system/example_process_1.f90!}
+```

example/CMakeLists.txt

@@ -30,4 +30,5 @@ add_subdirectory(stats_distribution_uniform)
 add_subdirectory(stringlist_type)
 add_subdirectory(strings)
 add_subdirectory(string_type)
+add_subdirectory(system)
 add_subdirectory(version)

example/system/CMakeLists.txt

@@ -0,0 +1,8 @@
+ADD_EXAMPLE(process_1)
+ADD_EXAMPLE(process_2)
+ADD_EXAMPLE(process_3)
+ADD_EXAMPLE(process_4)
+ADD_EXAMPLE(process_5)
+ADD_EXAMPLE(process_6)
+ADD_EXAMPLE(process_7)
+ADD_EXAMPLE(sleep)

example/system/example_process_1.f90

@@ -0,0 +1,24 @@
+! Process example 1: Run a Command Synchronously and Capture Output
+program run_sync
+    use stdlib_system, only: run, is_completed, is_windows, process_type
+    implicit none
+
+    type(process_type) :: p
+    logical :: completed
+
+    ! Run a synchronous process to list directory contents
+    if (is_windows()) then
+        p = run("dir", want_stdout=.true.)
+    else
+        p = run("ls -l", want_stdout=.true.)
+    end if
+
+    ! Check if the process is completed (should be true since wait=.true.)
+    if (is_completed(p)) then
+        print *, "Process completed successfully. The current directory: "
+        print *, p%stdout
+    else
+        print *, "Process is still running (unexpected)."
+    end if
+    
+end program run_sync

example/system/example_process_2.f90

@@ -0,0 +1,21 @@
+! Process example 2: Run an Asynchronous Command and check its status
+program run_async
+    use stdlib_system, only: process_type, runasync, is_running, wait
+    implicit none
+
+    type(process_type) :: p
+
+    ! Run an asynchronous process to sleep for 1 second
+    p = runasync("sleep 1")
+
+    ! Check if the process is running
+    if (is_running(p)) then
+        print *, "Process is running."
+    else
+        print *, "Process has already completed."
+    end if
+
+    ! Wait for the process to complete
+    call wait(p, max_wait_time = 5.0)
+    print *, "Process has now completed."
+end program run_async

example/system/example_process_3.f90

@@ -0,0 +1,22 @@
+! Process example 3: Run with many arguments, and check runtime
+program run_with_args
+    use stdlib_system, only: process_type, run, elapsed, wait
+    implicit none
+
+    type(process_type) :: p
+    character(len=15), allocatable :: args(:)
+
+    ! Define arguments for the `echo` command
+    allocate(args(2))
+    args(1) = "echo"
+    args(2) = "Hello, Fortran!"
+
+    ! Run the command with arguments (synchronous)
+    p = run(args)
+
+    ! Print the runtime of the process
+    print *, "Process runtime:", elapsed(p), "seconds."
+
+    ! Clean up
+    deallocate(args)
+end program run_with_args

example/system/example_process_4.f90

@@ -0,0 +1,35 @@
+! Process example 4: Kill a running process
+program example_process_kill
+    use stdlib_system, only: process_type, runasync, is_running, kill, elapsed, is_windows, sleep
+    implicit none
+    type(process_type) :: process
+    logical :: running, success
+
+    print *, "Starting a long-running process..."
+    if (is_windows()) then
+        process = runasync("ping -n 10 127.0.0.1")
+    else
+        process = runasync("ping -c 10 127.0.0.1")
+    endif
+
+    ! Verify the process is running
+    running = is_running(process)
+    print *, "Process running:", running
+
+    ! Wait a bit before killing the process
+    call sleep(millisec=250) 
+
+    print *, "Killing the process..."
+    call kill(process, success)
+
+    if (success) then
+        print *, "Process killed successfully."
+    else
+        print *, "Failed to kill the process."
+    endif
+
+    ! Verify the process is no longer running
+    running = is_running(process)
+    print *, "Process running after kill:", running
+
+end program example_process_kill

example/system/example_process_5.f90

@@ -0,0 +1,28 @@
+! Process example 5: Object-oriented interface
+program example_process_5
+    use stdlib_system, only: process_type, runasync, is_windows, sleep, update
+    implicit none
+    type(process_type) :: process
+
+    if (is_windows()) then
+        process = runasync("ping -n 10 127.0.0.1")
+    else
+        process = runasync("ping -c 10 127.0.0.1")
+    endif
+
+    ! Verify the process is running
+    do while (process%is_running())
+        
+        ! Update process state
+        call update(process)
+        
+        ! Wait a bit before killing the process
+        call sleep(millisec=1500)
+        
+        print *, "Process has been running for ",process%elapsed()," seconds..."
+
+    end do
+    
+    print *, "Process ",process%pid()," completed in ",process%elapsed()," seconds."
+    
+end program example_process_5

example/system/example_process_6.f90

@@ -0,0 +1,45 @@
+! Process example 6: Demonstrate callback 
+program example_process_6
+    use stdlib_system, only: process_type, process_ID, run, is_running, kill, elapsed, is_windows, sleep
+    implicit none
+    type(process_type) :: p
+    integer, target :: nfiles
+
+    ! Run process, attach callback function and some data
+    if (is_windows()) then
+        p = run("dir",want_stdout=.true.,callback=get_dir_nfiles)
+    else
+        p = run("ls -l",want_stdout=.true.,callback=get_dir_nfiles,payload=nfiles)
+    endif
+
+    ! On exit, the number of files should have been extracted by the callback function
+    print *, "Current directory has ",nfiles," files"
+    
+    contains
+        
+       ! Custom callback function: retrieve number of files from ls output
+       subroutine get_dir_nfiles(pid, exit_state, stdin, stdout, stderr, payload)
+           integer(process_ID), intent(in) :: pid
+           integer, intent(in) :: exit_state
+           character(len=*), optional, intent(in) :: stdin, stdout, stderr
+           class(*), optional, intent(inout) :: payload    
+           
+           integer :: i
+
+           if (present(payload)) then 
+            
+               select type (nfiles => payload)
+                   type is (integer)
+                       if (present(stdout)) then 
+                           nfiles = count([ (stdout(i:i) == char(10), i=1,len(stdout)) ])
+                       else
+                           nfiles = -1
+                       endif 
+                   class default
+                       error stop 'Wrong payload passed to the process'
+               end select            
+            
+           end if
+       end subroutine get_dir_nfiles     
+
+end program example_process_6

example/system/example_process_7.f90

@@ -0,0 +1,21 @@
+! Process example 7: Usage of `kill`
+program example_process_7
+    use stdlib_system, only: process_type, runasync, kill
+    implicit none
+
+    type(process_type) :: p
+    logical :: success
+
+    ! Start a process asynchronously
+    p = runasync("sleep 10")
+
+    ! Attempt to kill the process
+    call kill(p, success)
+
+    if (success) then
+        print *, "Process successfully killed."
+    else
+        print *, "Failed to kill the process."
+    end if
+    
+end program example_process_7    

example/system/example_sleep.f90

@@ -0,0 +1,13 @@
+! Usage of `sleep`
+program example_sleep
+    use stdlib_system, only: sleep
+    implicit none
+
+    print *, "Starting sleep..."
+
+    ! Sleep for 500 milliseconds
+    call sleep(500)
+
+    print *, "Finished sleeping!"
+    
+end program example_sleep    

src/CMakeLists.txt

@@ -109,6 +109,8 @@ set(SRC
     stdlib_hashmap_open.f90
     stdlib_logger.f90
     stdlib_sorting_radix_sort.f90
+    stdlib_system_subprocess.c
+    stdlib_system_subprocess.F90
     stdlib_system.F90
     stdlib_sparse.f90
     stdlib_specialfunctions.f90

src/stdlib_strings.fypp

@@ -185,7 +185,6 @@ module stdlib_strings
         module procedure :: join_char
     end interface join
 
-
 contains
 
 

src/stdlib_system.F90

@@ -0,0 +1,399 @@
+#include <sys/types.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdbool.h>
+#include <stdint.h>
+#include <string.h>
+
+#ifdef _WIN32
+#include <windows.h>
+#else
+#define _POSIX_C_SOURCE 199309L
+#include <sys/wait.h>
+#include <unistd.h>
+#include <time.h>
+#include <errno.h>
+#include <signal.h>
+#endif // _WIN32
+
+// Typedefs
+typedef void* stdlib_handle;
+typedef int64_t stdlib_pid;
+
+
+/////////////////////////////////////////////////////////////////////////////////////
+// Windows-specific code
+/////////////////////////////////////////////////////////////////////////////////////
+#ifdef _WIN32
+
+// On Windows systems: create a new process
+void process_create_windows(const char* cmd, const char* stdin_stream,  
+                    const char* stdin_file, const char* stdout_file, const char* stderr_file, 
+                    stdlib_pid* pid) {
+                                                  
+    STARTUPINFO si;
+    PROCESS_INFORMATION pi;
+    HANDLE hStdout = NULL, hStderr = NULL;
+    SECURITY_ATTRIBUTES sa = { sizeof(SECURITY_ATTRIBUTES), NULL, TRUE };
+    FILE* stdin_fp = NULL;
+    
+    // Initialize null handle
+    (*pid) = 0;
+
+    ZeroMemory(&si, sizeof(si));
+    si.cb = sizeof(STARTUPINFO);
+    
+    // If possible, we redirect stdout/stderr to file handles directly. 
+    // This will override any cmd redirection settings (<>). For stdin
+
+    // Write stdin_stream to stdin_file if provided
+    if (stdin_stream && stdin_file) {
+        stdin_fp = fopen(stdin_file, "w");
+        if (!stdin_fp) {
+            fprintf(stderr, "Failed to open stdin file for writing\n");
+            return;
+        }
+        fputs(stdin_stream, stdin_fp);
+        fclose(stdin_fp);
+    }
+
+    // Open stdout file if provided, otherwise use the null device
+    if (stdout_file) {
+        hStdout = CreateFile(stdout_file, GENERIC_WRITE, 0, &sa, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL);
+        if (hStdout == INVALID_HANDLE_VALUE) {
+            fprintf(stderr, "Failed to open stdout file\n");
+            return;
+        }
+    } else {
+        hStdout = CreateFile("NUL", GENERIC_WRITE, 0, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
+        if (hStdout == INVALID_HANDLE_VALUE) {
+            fprintf(stderr, "Failed to open null device for stdout\n");
+            return;
+        }
+    }
+    si.hStdOutput = hStdout;
+    si.dwFlags |= STARTF_USESTDHANDLES;
+
+    // Open stderr file if provided, otherwise use the null device
+    if (stderr_file) {
+        hStderr = CreateFile(stderr_file, GENERIC_WRITE, 0, &sa, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL);
+        if (hStderr == INVALID_HANDLE_VALUE) {
+            fprintf(stderr, "Failed to open stderr file\n");
+            return;
+        }
+    } else {
+        hStderr = CreateFile("NUL", GENERIC_WRITE, 0, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
+        if (hStderr == INVALID_HANDLE_VALUE) {
+            fprintf(stderr, "Failed to open null device for stderr\n");
+            return;
+        }
+    }
+    si.hStdError = hStderr;
+    si.dwFlags |= STARTF_USESTDHANDLES;
+    
+    // Prepare the command line with redirected stdin
+    char* full_cmd;
+    size_t cmd_len = strlen(cmd);
+    size_t stdin_len = stdin_file ? strlen(stdin_file) : 0;    
+    size_t full_cmd_len = cmd_len + stdin_len + 5;
+    full_cmd = (char*)malloc(full_cmd_len);
+    if (!full_cmd) {
+        fprintf(stderr, "Failed to allocate memory for full_cmd\n");
+        return;
+    }
+    
+    // Use full_cmd as needed (e.g., pass to CreateProcess)    
+    if (stdin_file) {
+        snprintf(full_cmd, full_cmd_len, "%s < %s", cmd, stdin_file);
+    } else {
+        snprintf(full_cmd, full_cmd_len, "%s", cmd);
+    }
+
+    // Create the process
+    BOOL success = CreateProcess(
+        NULL,               // Application name
+        full_cmd,           // Command line
+        NULL,               // Process security attributes
+        NULL,               // Thread security attributes
+        TRUE,               // Inherit handles
+        0,                  // Creation flags
+        NULL,               // Environment variables
+        NULL,               // Current directory
+        &si,                // STARTUPINFO
+        &pi                 // PROCESS_INFORMATION
+    );
+
+    // Free the allocated memory
+    free(full_cmd);    
+    
+    if (!success) {
+        fprintf(stderr, "CreateProcess failed (%lu).\n", GetLastError());
+        return;
+    }
+
+    // Close unneeded handles
+    if (hStdout) CloseHandle(hStdout);
+    if (hStderr) CloseHandle(hStderr);
+
+    // Return the process handle for status queries
+    CloseHandle(pi.hThread);  // Close the thread handle
+    (*pid) = (stdlib_pid) pi.dwProcessId;
+    
+}
+
+// Query process state on a Windows system
+void process_query_status_windows(stdlib_pid pid, bool wait, bool* is_running, int* exit_code)
+{
+    int wait_code;
+    HANDLE hProcess;
+    DWORD dwExitCode,dwPid;
+    
+    dwPid = (DWORD) pid;    
+    
+    // Open the process with the appropriate access rights
+    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION | SYNCHRONIZE, FALSE, dwPid);
+    
+    // Error opening the process, likely pid does not exist
+    if (hProcess == NULL) {
+        *is_running = false;
+        *exit_code = -1; 
+        return;
+    }
+
+    
+    if (wait) {
+        // Wait for the process to terminate
+        wait_code = WaitForSingleObject(hProcess, INFINITE);
+    } else {
+        // Check if the process has terminated
+        wait_code = WaitForSingleObject(hProcess, 0);
+    }
+
+    if (wait_code == WAIT_OBJECT_0) {
+        // Process has exited, get the exit code
+        *is_running = false;        
+        if (GetExitCodeProcess(hProcess, &dwExitCode)) {            
+            *exit_code = dwExitCode;
+        } else {
+            *exit_code = -1; // Error retrieving the exit code
+        }
+    } else if (wait_code == WAIT_TIMEOUT) {
+        // Process is still running
+        *is_running = true;
+        *exit_code = 0;
+    } else { // WAIT_FAILED
+        // Error occurred
+        *is_running = false;
+        *exit_code = -1; // Error occurred in WaitForSingleObject
+    }
+
+    // Close the process handle
+    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(stdlib_pid pid) {
+    HANDLE hProcess;
+    DWORD dwPid;
+    
+    dwPid = (DWORD) pid;
+
+    // Open the process with terminate rights
+    hProcess = OpenProcess(PROCESS_TERMINATE, FALSE, dwPid);
+
+    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
+
+/////////////////////////////////////////////////////////////////////////////////////
+// Unix-specific code
+/////////////////////////////////////////////////////////////////////////////////////
+void process_query_status_unix(stdlib_pid pid, bool wait, bool* is_running, int* exit_code)
+{
+    int status;    
+    int wait_code;
+    
+    // Wait or return immediately if no status change
+    int options = wait ? 0 : WNOHANG; 
+
+    // Call waitpid to check the process state
+    wait_code = waitpid(pid, &status, options);
+
+    if (wait_code > 0) {
+        // Process state was updated
+        if (WIFEXITED(status)) {
+            *is_running = false;
+            
+            // Get exit code
+            *exit_code = WEXITSTATUS(status); 
+        } else if (WIFSIGNALED(status)) {
+            *is_running = false;
+            
+            // Use negative value to indicate termination by signal
+            *exit_code = -WTERMSIG(status); 
+        } else {
+            // Process is still running: no valid exit code yet
+            *is_running = true; 
+            *exit_code = 0; 
+        }
+    } else if (wait_code == 0) {
+        // No status change; process is still running
+        *is_running = true;
+        *exit_code = 0;
+    } else {
+        // Error occurred
+        *is_running = false;
+        *exit_code = -1; // Indicate an error
+    }
+}
+
+// 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(stdlib_pid 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_pid* pid) 
+{
+
+    (*pid) = (stdlib_pid) fork();
+}
+
+#endif // _WIN32
+
+/////////////////////////////////////////////////////////////////////////////////////
+// Cross-platform interface
+/////////////////////////////////////////////////////////////////////////////////////
+
+// Create or fork process
+void process_create(const char* cmd, const char* stdin_stream, const char* stdin_file, 
+                    const char* stdout_file, const char* stderr_file, 
+                    stdlib_pid* pid) {                                                  
+#ifdef _WIN32
+    process_create_windows(cmd, stdin_stream, stdin_file, stdout_file, stderr_file, pid);
+#else
+    process_create_posix(pid);
+#endif // _WIN32
+}
+
+// Cross-platform interface: query process state
+void process_query_status(stdlib_pid pid, bool wait, bool* is_running, int* exit_code)
+{
+#ifdef _WIN32
+   process_query_status_windows(pid, wait, is_running, exit_code);
+#else
+   process_query_status_unix   (pid, wait, is_running, exit_code);
+#endif // _WIN32
+}
+
+// Cross-platform interface: kill process by ID
+bool process_kill(stdlib_pid 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)
+{
+#ifdef _WIN32
+   DWORD dwMilliseconds = (DWORD) (seconds * 1000);
+   Sleep(dwMilliseconds);
+#else
+   int ierr;
+   
+   unsigned int ms = (unsigned int) (seconds * 1000);
+   struct timespec ts_remaining =
+   { 
+     ms / 1000, 
+     (ms % 1000) * 1000000L 
+   };   
+   
+   do
+   {
+     struct timespec ts_sleep = ts_remaining;
+     ierr = nanosleep(&ts_sleep, &ts_remaining);
+   } 
+   while ((EINTR == errno) && (-1 == ierr));
+      
+   if (ierr != 0){
+     switch(errno){
+       case EINTR:
+         fprintf(stderr, "nanosleep() interrupted\n");
+         break;
+       case EINVAL:
+         fprintf(stderr, "nanosleep() bad milliseconds value\n");
+         exit(EINVAL);
+       case EFAULT:
+         fprintf(stderr, "nanosleep() problem copying information to user space\n");
+         exit(EFAULT);
+       case ENOSYS:
+         fprintf(stderr, "nanosleep() not supported on this system\n");
+         exit(ENOSYS);
+       default:
+         fprintf(stderr, "nanosleep() error\n");
+         exit(1);
+     }
+   }   
+   
+#endif // _WIN32    
+}
+
+// Returns the cross-platform file path of the null device for the current operating system.
+const char* process_null_device(int* len) 
+{
+#ifdef _WIN32    
+        (*len) = strlen("NUL");
+        return "NUL";
+#else
+        (*len) = strlen("/dev/null");
+        return "/dev/null";
+#endif
+}
+
+// Returns a boolean flag if macro _WIN32 is defined
+bool process_is_windows()
+{
+#ifdef _WIN32
+   return true;
+#else
+   return false;
+#endif // _WIN32
+}
+

src/stdlib_system_subprocess.F90

@@ -1 +1,2 @@
 ADDTEST(sleep)
+ADDTEST(subprocess)

src/stdlib_system_subprocess.c

@@ -0,0 +1,147 @@
+module test_subprocess
+    use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test
+    use stdlib_system, only: process_type, run, runasync, is_running, wait, update, elapsed, is_windows, kill
+
+    implicit none
+
+contains
+
+    !> Collect all exported unit tests
+    subroutine collect_suite(testsuite)
+        !> Collection of tests
+        type(unittest_type), allocatable, intent(out) :: 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
+
+    !> Test running a synchronous process
+    subroutine test_run_synchronous(error)
+        type(error_type), allocatable, intent(out) :: error
+        type(process_type) :: process
+        character(len=*), parameter :: command = "echo Hello"
+
+        process = run(command, want_stdout=.true.)
+        call check(error, process%completed)
+        if (allocated(error)) return
+        
+        call check(error, trim(process%stdout) == "Hello", "stdout=<"//trim(process%stdout)//">, expected <Hello>")
+    end subroutine test_run_synchronous
+
+    !> Test running an asynchronous process
+    subroutine test_run_asynchronous(error)
+        type(error_type), allocatable, intent(out) :: error
+        type(process_type) :: process
+        logical :: running
+
+        ! The closest possible to a cross-platform command that waits
+        if (is_windows()) then 
+            process = runasync("ping -n 2 127.0.0.1")
+        else
+            process = runasync("ping -c 2 127.0.0.1")
+        endif
+        ! Should not be immediately completed
+        call check(error, .not. process%completed, "ping process should not complete immediately")
+        if (allocated(error)) return
+
+        running = is_running(process)
+        call check(error, running, "ping process should still be running immediately after started")
+        if (allocated(error)) return
+
+        call wait(process)
+        call check(error, process%completed, "process should be complete after `call wait`")
+        if (allocated(error)) return
+
+        call check(error, elapsed(process)>1.0e-4, "There should be a non-zero elapsed time")
+        
+    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 (is_windows()) then
+            process = runasync("ping -n 10 127.0.0.1")
+        else
+            process = runasync("ping -c 10 127.0.0.1")
+        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
+        type(process_type) :: process
+        character(len=*), parameter :: command = "echo Testing"
+
+        process = run(command, want_stdout=.true., want_stderr=.true.)
+
+        call update(process)
+        call check(error, process%completed)
+        if (allocated(error)) return
+
+        call check(error, process%exit_code == 0, "Check zero exit code")
+        if (allocated(error)) return
+        
+        call check(error, len_trim(process%stderr) == 0, "Check no stderr output")
+        if (allocated(error)) return
+
+        call check(error, trim(process%stdout) == "Testing", "stdout=<"//trim(process%stdout)//">, expected <Testing>")
+        if (allocated(error)) return
+    end subroutine test_process_state
+
+end module test_subprocess
+
+program tester
+    use, intrinsic :: iso_fortran_env, only : error_unit
+    use testdrive, only : run_testsuite, new_testsuite, testsuite_type
+    use test_subprocess, only : collect_suite
+
+    implicit none
+
+    integer :: stat, is
+    type(testsuite_type), allocatable :: testsuites(:)
+    character(len=*), parameter :: fmt = '("#", *(1x, a))'
+
+    stat = 0
+
+    testsuites = [ &
+        new_testsuite("subprocess", collect_suite) &
+    ]
+
+    do is = 1, size(testsuites)
+        write(error_unit, fmt) "Testing:", testsuites(is)%name
+        call run_testsuite(testsuites(is)%collect, error_unit, stat)
+    end do
+
+    if (stat > 0) then
+        write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!"
+        error stop
+    end if
+end program