Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

system: subprocessing interface #911

Merged
merged 60 commits into from
Feb 25, 2025
Merged
Changes from all commits
Commits
Show all changes
60 commits
Select commit Hold shift + click to select a range
979ba84
add c source
perazz Dec 24, 2024
79ddfc4
add subprocess module
perazz Dec 24, 2024
adacbcf
`to_c_string`: move to strings, document
perazz Dec 24, 2024
5b543a2
use temporary `getfile` and `linalg_state_type` f
perazz Dec 24, 2024
519d53d
implement `join`
perazz Dec 24, 2024
1449b8d
fixes to build
perazz Dec 24, 2024
cf35194
create submodule
perazz Dec 24, 2024
e8451b2
unify `sleep` interface
perazz Dec 24, 2024
48da380
add single-command `run` API
perazz Dec 24, 2024
1f4de32
add tests
perazz Dec 24, 2024
6fbc2e6
getfile: remove trailing new line characters
perazz Dec 24, 2024
f9bf304
fix tests to be cross-platform
perazz Dec 24, 2024
71facb3
use `nanosleep` rather than `usleep`
perazz Dec 24, 2024
6ea72d1
add examples
perazz Dec 24, 2024
e35b37a
`kill` process
perazz Dec 24, 2024
237e9ff
add process killing example
perazz Dec 24, 2024
2c58fca
on Windows, redirect to `NUL` if output not requested
perazz Dec 24, 2024
136b5b8
remove unused process handle
perazz Dec 25, 2024
d8df028
document `run` interface
perazz Dec 25, 2024
94f2bdf
document `is_running`, `is_completed`, `elapsed`
perazz Dec 25, 2024
3fb88e4
add `system` page
perazz Dec 25, 2024
53fc8e5
document `wait`
perazz Dec 25, 2024
b30cae4
document `update`
perazz Dec 25, 2024
122fbc6
document `kill`
perazz Dec 25, 2024
56ed7c8
document `sleep`
perazz Dec 25, 2024
c617048
document `has_win32`
perazz Dec 25, 2024
ed0565c
fix
perazz Dec 25, 2024
c03655a
Merge branch 'subprocess' of github.com:perazz/stdlib into subprocess
perazz Dec 26, 2024
eb77455
Merge branch 'fortran-lang:master' into subprocess
perazz Dec 26, 2024
74b6ebe
change syntax for `ifx` fix
perazz Dec 26, 2024
9873bc9
fix `sleep` us -> ns
perazz Dec 26, 2024
34732ff
fix `pid` size
perazz Dec 26, 2024
53b03b0
full-cmd: do not use stack
perazz Dec 26, 2024
5a1bd54
fix `sleep`
perazz Dec 26, 2024
9b74bea
process example 2: set max_wait_time
perazz Dec 26, 2024
bdb2840
sleep: fix `bind(C)` interface
perazz Dec 26, 2024
a1aaf2f
split `run` vs `runasync`
perazz Jan 28, 2025
4d5eb32
`run/runasync` docs
perazz Jan 28, 2025
56f02ab
`has_win32` -> `is_windows`
perazz Jan 28, 2025
15689bc
Update example_process_1.f90
perazz Jan 28, 2025
060dec7
Merge branch 'master' into subprocess
perazz Jan 28, 2025
3560a6f
missing `is_windows` tests
perazz Jan 28, 2025
e75bbc9
Merge branch 'subprocess' of github.com:perazz/stdlib into subprocess
perazz Jan 28, 2025
d1a4715
Update example_process_4.f90
perazz Jan 28, 2025
68dca8d
Merge branch 'fortran-lang:master' into subprocess
perazz Jan 29, 2025
7653cc4
add object oriented interface
perazz Feb 4, 2025
06c7136
add oop example
perazz Feb 4, 2025
f40a547
process ID (`pid`) getter interface
perazz Feb 4, 2025
d2ee2f2
implement callback
perazz Feb 4, 2025
3f08a8b
add callback example
perazz Feb 4, 2025
d694dcf
fix submodule
perazz Feb 4, 2025
80a2d0a
intel fix: no inline type
perazz Feb 4, 2025
20c045d
document callback and payload functionality
perazz Feb 4, 2025
bb98188
Merge branch 'master' into subprocess
perazz Feb 17, 2025
33f81a3
`to_c_string` -> `to_c_char`
perazz Feb 17, 2025
d8f8be7
Merge branch 'subprocess' of https://github.com/perazz/stdlib into su…
perazz Feb 17, 2025
deabd0c
Update doc/specs/stdlib_system.md
perazz Feb 17, 2025
f55ddb7
Update doc/specs/stdlib_system.md
perazz Feb 17, 2025
d4422cf
move all examples to separate files
perazz Feb 17, 2025
0675b8c
Merge branch 'subprocess' of https://github.com/perazz/stdlib into su…
perazz Feb 17, 2025
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion CMakeLists.txt
Original file line number Diff line number Diff line change
@@ -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"
)

2 changes: 1 addition & 1 deletion config/fypp_deployment.py
Original file line number Diff line number Diff line change
@@ -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')
1 change: 1 addition & 0 deletions doc/specs/index.md
Original file line number Diff line number Diff line change
@@ -37,6 +37,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
1 change: 1 addition & 0 deletions doc/specs/stdlib_strings.md
Original file line number Diff line number Diff line change
@@ -498,6 +498,7 @@ The result is of the same type as the elements of `strings` (`type(string_type)`
```

<!-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->

### `to_string`

#### Description
337 changes: 337 additions & 0 deletions doc/specs/stdlib_system.md
Original file line number Diff line number Diff line change
@@ -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!}
```
1 change: 1 addition & 0 deletions example/CMakeLists.txt
Original file line number Diff line number Diff line change
@@ -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)
8 changes: 8 additions & 0 deletions example/system/CMakeLists.txt
Original file line number Diff line number Diff line change
@@ -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)
24 changes: 24 additions & 0 deletions example/system/example_process_1.f90
Original file line number Diff line number Diff line change
@@ -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
21 changes: 21 additions & 0 deletions example/system/example_process_2.f90
Original file line number Diff line number Diff line change
@@ -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
22 changes: 22 additions & 0 deletions example/system/example_process_3.f90
Original file line number Diff line number Diff line change
@@ -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
35 changes: 35 additions & 0 deletions example/system/example_process_4.f90
Original file line number Diff line number Diff line change
@@ -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
28 changes: 28 additions & 0 deletions example/system/example_process_5.f90
Original file line number Diff line number Diff line change
@@ -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
45 changes: 45 additions & 0 deletions example/system/example_process_6.f90
Original file line number Diff line number Diff line change
@@ -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
21 changes: 21 additions & 0 deletions example/system/example_process_7.f90
Original file line number Diff line number Diff line change
@@ -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
13 changes: 13 additions & 0 deletions example/system/example_sleep.f90
Original file line number Diff line number Diff line change
@@ -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
2 changes: 2 additions & 0 deletions src/CMakeLists.txt
Original file line number Diff line number Diff line change
@@ -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
1 change: 0 additions & 1 deletion src/stdlib_strings.fypp
Original file line number Diff line number Diff line change
@@ -185,7 +185,6 @@ module stdlib_strings
module procedure :: join_char
end interface join


contains


456 changes: 420 additions & 36 deletions src/stdlib_system.F90

Large diffs are not rendered by default.

763 changes: 763 additions & 0 deletions src/stdlib_system_subprocess.F90

Large diffs are not rendered by default.

399 changes: 399 additions & 0 deletions src/stdlib_system_subprocess.c
Original file line number Diff line number Diff line change
@@ -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
}

1 change: 1 addition & 0 deletions test/system/CMakeLists.txt
Original file line number Diff line number Diff line change
@@ -1 +1,2 @@
ADDTEST(sleep)
ADDTEST(subprocess)
147 changes: 147 additions & 0 deletions test/system/test_subprocess.f90
Original file line number Diff line number Diff line change
@@ -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