From 979ba84c287e5331a5d0420a30403c579e084f52 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 24 Dec 2024 11:43:02 +0100 Subject: [PATCH 01/52] add c source --- CMakeLists.txt | 2 +- config/fypp_deployment.py | 4 +- src/CMakeLists.txt | 1 + src/stdlib_system_subprocess.c | 252 +++++++++++++++++++++++++++++++++ 4 files changed, 256 insertions(+), 3 deletions(-) create mode 100644 src/stdlib_system_subprocess.c diff --git a/CMakeLists.txt b/CMakeLists.txt index b10e1f73d..3034ed761 100644 --- a/CMakeLists.txt +++ b/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" ) diff --git a/config/fypp_deployment.py b/config/fypp_deployment.py index ee7cb02cd..27e04a306 100644 --- a/config/fypp_deployment.py +++ b/config/fypp_deployment.py @@ -97,7 +97,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), 'stdlib-fpm'+os.sep+folder+os.sep+file) recursive_copy('src') recursive_copy('test') @@ -162,4 +162,4 @@ def fpm_build(args,unknown): #========================================== # build using fpm if args.build: - fpm_build(args,unknown) \ No newline at end of file + fpm_build(args,unknown) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index ff9f39417..1e842bc1c 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -117,6 +117,7 @@ set(SRC stdlib_hashmap_open.f90 stdlib_logger.f90 stdlib_sorting_radix_sort.f90 + stdlib_system_subprocess.c stdlib_system.F90 stdlib_sparse.f90 stdlib_specialfunctions.f90 diff --git a/src/stdlib_system_subprocess.c b/src/stdlib_system_subprocess.c new file mode 100644 index 000000000..1d40e875b --- /dev/null +++ b/src/stdlib_system_subprocess.c @@ -0,0 +1,252 @@ +#include +#include +#include +#include + +#ifdef _WIN32 +#include +#else +#include +#include +#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_handle* handle, 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 + (*handle) = NULL; + (*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 + 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; + } + si.hStdOutput = hStdout; + si.dwFlags |= STARTF_USESTDHANDLES; + } + + // Open stderr file if provided + 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; + } + si.hStdError = hStderr; + si.dwFlags |= STARTF_USESTDHANDLES; + } + + // Prepare the command line with redirected stdin + char full_cmd[4096]; + if (stdin_file) { + snprintf(full_cmd, sizeof(full_cmd), "%s < %s", cmd, stdin_file); + } else { + snprintf(full_cmd, sizeof(full_cmd), "%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 + ); + + if (!success) { + fprintf(stderr, "CreateProcess failed (%lud).\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 + (*handle) = (stdlib_handle) pi.hProcess; // Return the process handle + (*pid) = (stdlib_pid) pi.dwProcessId; + +} + +// Query process state on a Windows system +void process_query_status_windows(int pid, bool wait, bool* is_running, int* exit_code) +{ + int wait_code; + HANDLE hProcess; + DWORD dwExitCode; + + // Open the process with the appropriate access rights + hProcess = OpenProcess(PROCESS_QUERY_INFORMATION | SYNCHRONIZE, FALSE, pid); + + // 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); +} + +#else // _WIN32 + +///////////////////////////////////////////////////////////////////////////////////// +// Unix-specific code +///////////////////////////////////////////////////////////////////////////////////// +void process_query_status_unix(int 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 + } +} + +// 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) +{ + + (*handle) = NULL; + (*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_handle* handle, stdlib_pid* pid) { +#ifdef _WIN32 + process_create_windows(cmd, stdin_stream, stdin_file, stdout_file, stderr_file, handle, pid); +#else + process_create_posix(handle, pid); +#endif // _WIN32 +} + +// Cross-platform interface: query process state +void process_query_status(int 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: sleep(seconds) +void process_wait(float seconds) +{ +#ifdef _WIN32 + DWORD dwMilliseconds = 1000*seconds; + Sleep(dwMilliseconds); +#else + int uSeconds = (int) 1.0e6*seconds; + usleep(uSeconds); +#endif // _WIN32 +} From 79ddfc491b575b2149516e429253e20211dc3e3d Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 24 Dec 2024 11:46:11 +0100 Subject: [PATCH 02/52] add subprocess module --- src/CMakeLists.txt | 1 + src/stdlib_system_subprocess.F90 | 428 +++++++++++++++++++++++++++++++ 2 files changed, 429 insertions(+) create mode 100644 src/stdlib_system_subprocess.F90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 1e842bc1c..5931bf772 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -118,6 +118,7 @@ set(SRC 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 diff --git a/src/stdlib_system_subprocess.F90 b/src/stdlib_system_subprocess.F90 new file mode 100644 index 000000000..dda0a7c55 --- /dev/null +++ b/src/stdlib_system_subprocess.F90 @@ -0,0 +1,428 @@ +module fortran_subprocess + use iso_c_binding + use iso_fortran_env, only: int64, real64 + use stdlib_system + implicit none + public + + ! Interoperable types + integer, parameter, public :: pid_t = c_int64_t + + logical(c_bool), parameter, private :: C_FALSE = .false._c_bool + logical(c_bool), parameter, private :: C_TRUE = .true._c_bool + + ! CPU clock ticks range + integer, parameter, private :: TICKS = int64 + integer, parameter, private :: RTICKS = real64 + + ! Number of CPU ticks between status updates + integer(TICKS), parameter :: CHECK_EVERY_TICKS = 100 + + ! Default flag for the runner process + integer(pid_t), parameter :: FORKED_PROCESS = 0_pid_t + + ! Interface to C support functions from stdlib_system_subprocess.c + interface + + ! C wrapper to query process status + subroutine process_query_status(pid, wait, is_running, exit_code) & + bind(C, name='process_query_status') + import c_int, c_bool, pid_t + implicit none + ! Process ID + integer(pid_t), value :: pid + ! Whether to wait for process completion + logical(c_bool), value :: wait + ! Whether the process is still running + logical(c_bool), intent(out) :: is_running + ! Process exit code (or error code) + integer(c_int), intent(out) :: exit_code + end subroutine process_query_status + + subroutine process_create(cmd, stdin_stream, stdin_file, stdout_file, stderr_file, handle, pid) & + bind(C, name='process_create') + import c_char, c_ptr, pid_t + implicit none + character(c_char), intent(in) :: cmd(*) + character(c_char), intent(in), optional :: stdin_stream(*) + character(c_char), intent(in), optional :: stdin_file(*) + character(c_char), intent(in), optional :: stdout_file(*) + character(c_char), intent(in), optional :: stderr_file(*) + type(c_ptr) , intent(out) :: handle + integer(pid_t), intent(out) :: pid + end subroutine process_create + + 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 interface + + type, public :: process_type + + !> Process ID (if external); 0 if run by the program process + integer(pid_t) :: id = FORKED_PROCESS + type(c_ptr) :: handle = c_null_ptr + + !> Process is completed + logical :: completed = .false. + integer(TICKS) :: start_time = 0 + + !> Process exit code + integer :: exit_code = 0 + + !> Stdin file name + character(:), allocatable :: stdin_file + + !> Standard output + character(:), allocatable :: stdout_file + character(:), allocatable :: stdout + + !> Error output + character(:), allocatable :: stderr_file + character(:), allocatable :: stderr + + !> Store time at the last update + integer(TICKS) :: last_update = 0 + + contains + + !> Return process lifetime so far, in seconds + procedure :: elapsed => process_lifetime + + !> Live check if a process is still running + procedure :: is_running => process_is_running + procedure :: is_completed => process_is_completed + + !> Wait until a running process is completed + procedure :: wait => wait_for_completion + + end type process_type + + +contains + + !> Open a new, asynchronous process + type(process_type) function process_open(args,wait,stdin,want_stdout,want_stderr) result(process) + !> The command and arguments + character(*), intent(in) :: args(:) + !> Optional character input to be sent to the process via pipe + character(*), optional, intent(in) :: stdin + !> Define if the process should be synchronous (wait=.true.), or asynchronous(wait=.false.) + logical, optional, intent(in) :: wait + !> Require collecting output + logical, optional, intent(in) :: want_stdout, want_stderr + + real(RTICKS) :: count_rate + logical :: asynchronous, collect_stdout, collect_stderr, has_stdin + integer :: command_state, exit_state + integer(TICKS) :: count_max + + ! Process user requests + asynchronous = .false. + collect_stdout = .false. + collect_stderr = .false. + has_stdin = present(stdin) + if (present(wait)) asynchronous = .not.wait + if (present(want_stdout)) collect_stdout = want_stdout + if (present(want_stderr)) collect_stderr = want_stderr + + ! Attach stdout to a scratch file (must be named) + if (has_stdin) process%stdin_file = scratch_name('inp') + if (collect_stdout) process%stdout_file = scratch_name('out') + if (collect_stderr) process%stderr_file = scratch_name('err') + + ! Save the process's generation time + call system_clock(process%start_time,count_rate,count_max) + process%last_update = process%start_time + + if (asynchronous) then + + ! Create or fork a new process, store pid + call launch_asynchronous(process, args, stdin) + + else + + ! No need to create an external process + process%id = FORKED_PROCESS + + endif + + if (process%id == FORKED_PROCESS) then + + ! Launch to completion from the local process + call launch_synchronous(process, args, stdin) + call save_completed_state(process,delete_files=.not.asynchronous) + + ! If the process was forked + ! Note: use `exit` rather than `stop` to prevent the mandatory stdout STOP message + if (asynchronous) then + if (command_state/=0) then + ! Invalid command: didn't even start + call exit(command_state) + else + ! Return exit state + call exit(exit_state) + end if + endif + + endif + + + + ! Run a first update + call update_process_state(process) + + end function process_open + + subroutine launch_asynchronous(process, args, stdin) + class(process_type), intent(inout) :: process + !> The command and arguments + character(*), intent(in) :: args(:) + !> Optional character input to be sent to the process via pipe + character(*), optional, intent(in) :: stdin + + character(c_char), dimension(:), allocatable, target :: c_cmd,c_stdin,c_stdin_file,c_stdout_file,c_stderr_file + + ! Assemble C strings + c_cmd = c_string(join(args)) + if (present(stdin)) c_stdin = c_string(stdin) + if (allocated(process%stdin_file)) c_stdin_file = c_string(process%stdin_file) + if (allocated(process%stdout_file)) c_stdout_file = c_string(process%stdout_file) + if (allocated(process%stderr_file)) c_stderr_file = c_string(process%stderr_file) + + ! On Windows, this 1) creates 2) launches an external process from C. + ! On unix, this 1) forks an external process + call process_create(c_cmd, c_stdin, c_stdin_file, c_stdout_file, c_stderr_file, process%handle, process%id) + + end subroutine launch_asynchronous + + pure function c_string(str) result(cstr) + character(*), intent(in) :: str + character(c_char), allocatable :: cstr(:) + integer :: i + allocate(cstr(len(str)+1)) + forall(i=1:len(str)) cstr(i) = str(i:i) + cstr(len(str)+1) = c_null_char + end function c_string + + subroutine launch_synchronous(process, args, stdin) + class(process_type), intent(inout) :: process + !> The command and arguments + character(*), intent(in) :: args(:) + !> Optional character input to be sent to the process via pipe + character(*), optional, intent(in) :: stdin + + character(:), allocatable :: cmd + character(4096) :: iomsg + integer :: iostat,estat,cstat,stdin_unit + logical :: has_stdin + + has_stdin = present(stdin) + + ! Prepare stdin + if (has_stdin) then + + open(newunit=stdin_unit,file=process%stdin_file, & + access='stream',action='write',position='rewind', & + iostat=iostat,iomsg=iomsg) + if (iostat/=0) error stop 'cannot open temporary stdin' + + write(stdin_unit,iostat=iostat,iomsg=iomsg) stdin + if (iostat/=0) error stop trim(iomsg) + + close(stdin_unit,iostat=iostat,iomsg=iomsg,status='keep') + if (iostat/=0) error stop 'cannot close temporary stdin' + + end if + + ! Run command + cmd = assemble_cmd(args,process%stdin_file,process%stdout_file,process%stderr_file) + + ! Execute command + call execute_command_line(cmd,wait=.true.,exitstat=estat,cmdstat=cstat) + + ! Save state and output + process%exit_code = merge(cstat,estat,cstat/=0) + + end subroutine launch_synchronous + + !> Return the current (or total) process lifetime, in seconds + real(RTICKS) function process_lifetime(process) result(delta_t) + class(process_type), intent(in) :: process + + real(RTICKS) :: ticks_per_second + integer(TICKS) :: current_time,count_max + + ! Get current time + call system_clock(current_time,ticks_per_second,count_max) + + if (process%completed) then + + delta_t = real(process%last_update-process%start_time,RTICKS)/ticks_per_second + + else + + delta_t = real(current_time-process%start_time,RTICKS)/ticks_per_second + + end if + + end function process_lifetime + + !> Wait for a process to be completed + subroutine wait_for_completion(process, max_wait_time) + class(process_type), intent(inout) :: process + ! Optional max wait time in seconds + real, optional, intent(in) :: max_wait_time + + real(RTICKS) :: wait_time, elapsed + integer(TICKS) :: start_time, current_time, count_rate + + ! Determine the wait time + if (present(max_wait_time)) then + wait_time = max(0.0_RTICKS, max_wait_time) + else + ! No limit if max_wait_time is not provided + wait_time = huge(wait_time) + end if + + ! Get the system clock rate and the start time + call system_clock(start_time, count_rate) + elapsed = 0.0_real64 + + ! Wait loop + wait_loop: do while (process_is_running(process) .and. elapsed <= wait_time) + + ! Small sleep to avoid CPU hogging (1 ms) + call process_wait(0.001_c_float) + + call system_clock(current_time) + elapsed = real(current_time - start_time, RTICKS) / count_rate + + end do wait_loop + + end subroutine wait_for_completion + + !> Update a process's state, and + subroutine update_process_state(process) + class(process_type), intent(inout) :: process + + real(RTICKS) :: count_rate + integer(TICKS) :: count_max,current_time + logical(c_bool) :: is_running + integer(c_int) :: exit_code + + ! If the process has completed, should not be queried again + if (process%completed) return + + ! Save the process's generation time + call system_clock(current_time,count_rate,count_max) + + ! Only trigger an update after at least 100 count units + if (abs(real(current_time-process%last_update,RTICKS)) Live check if a process is running + logical function process_is_running(process) result(is_running) + class(process_type), intent(inout) :: process + + ! Each evaluation triggers a state update + call update_process_state(process) + + is_running = .not.process%completed + + end function process_is_running + + !> Live check if a process has completed + logical function process_is_completed(process) result(is_completed) + class(process_type), intent(inout) :: process + + ! Each evaluation triggers a state update + call update_process_state(process) + + is_completed = process%completed + + end function process_is_completed + + function scratch_name(prefix) result(temp_filename) + character(*), optional, intent(in) :: prefix + character(:), allocatable :: temp_filename + character(len=8) :: date + character(len=10) :: time + character(len=7) :: rand_str + real :: rrand + integer :: rand_val + + ! Get the current date and time + call date_and_time(date=date, time=time) + + ! Generate a random number for additional uniqueness + call random_number(rrand) + rand_val = nint(rrand * 1e6) ! Scale random number + write(rand_str,'(i7.7)') rand_val + + ! Construct the filename + if (present(prefix)) then + temp_filename = trim(prefix)// '_' // date // '_' // time(1:6) // '_' // rand_str // '.tmp' + else + temp_filename = 'tmp_' // date // '_' // time(1:6) // '_' // rand_str // '.tmp' + endif + + end function scratch_name + + +end module fortran_subprocess From adacbcf94e80338522c5096a09de8d5913bfbb99 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 24 Dec 2024 11:54:05 +0100 Subject: [PATCH 03/52] `to_c_string`: move to strings, document --- doc/specs/stdlib_strings.md | 30 ++++++++++++++++++++++++++++++ src/stdlib_strings.fypp | 14 ++++++++++++++ src/stdlib_system_subprocess.F90 | 11 ++--------- 3 files changed, 46 insertions(+), 9 deletions(-) diff --git a/doc/specs/stdlib_strings.md b/doc/specs/stdlib_strings.md index 099aa5521..24980c3b0 100644 --- a/doc/specs/stdlib_strings.md +++ b/doc/specs/stdlib_strings.md @@ -498,3 +498,33 @@ The result is an `allocatable` length `character` scalar with up to `128` cached ```fortran {!example/strings/example_to_string.f90!} ``` + + +### `to_c_string` + +#### Description + +Convert a Fortran character string to a C character array. +This function converts a Fortran string into a C-style string, ensuring proper null-termination for use in C functions or libraries. + +#### Syntax + +`cstr = ` [[stdlib_strings(module):to_c_string(function)]] ` (value)` + +#### Status + +Experimental + +#### Class + +Pure function. + +#### Argument + +- `value`: Shall be a `character(len=*)` string. + This is an `intent(in)` argument. + The Fortran string that will be converted to a C character array. + +#### Result value + +The result is a `character(kind=c_char)` array with a dimension of `len(value) + 1` to accommodate the null terminator. diff --git a/src/stdlib_strings.fypp b/src/stdlib_strings.fypp index a70bb38d2..6beb875f3 100644 --- a/src/stdlib_strings.fypp +++ b/src/stdlib_strings.fypp @@ -8,10 +8,12 @@ module stdlib_strings use stdlib_string_type, only: string_type, char, verify, repeat, len use stdlib_optval, only: optval use stdlib_kinds, only: sp, dp, xdp, qp, int8, int16, int32, int64, lk, c_bool + use iso_c_binding, only: c_char, c_null_char implicit none private public :: to_string + public :: to_c_string public :: strip, chomp public :: starts_with, ends_with public :: slice, find, replace_all, padl, padr, count, zfill @@ -943,5 +945,17 @@ contains end function zfill_char + !> Convert a Fortran character string to a C character array + !> + !> Version: experimental + pure function to_c_string(value) result(cstr) + character(len=*), intent(in) :: value + character(kind=c_char) :: cstr(len(value)+1) + integer :: i + do concurrent (i=1:len(value)) + cstr(i) = value(i:i) + end do + cstr(len(value)+1) = c_null_char + end function to_c_string end module stdlib_strings diff --git a/src/stdlib_system_subprocess.F90 b/src/stdlib_system_subprocess.F90 index dda0a7c55..c292d9963 100644 --- a/src/stdlib_system_subprocess.F90 +++ b/src/stdlib_system_subprocess.F90 @@ -2,6 +2,8 @@ module fortran_subprocess use iso_c_binding use iso_fortran_env, only: int64, real64 use stdlib_system + use stdlib_io, only: getfile + use stdlib_strings, only: to_c_string implicit none public @@ -199,15 +201,6 @@ subroutine launch_asynchronous(process, args, stdin) end subroutine launch_asynchronous - pure function c_string(str) result(cstr) - character(*), intent(in) :: str - character(c_char), allocatable :: cstr(:) - integer :: i - allocate(cstr(len(str)+1)) - forall(i=1:len(str)) cstr(i) = str(i:i) - cstr(len(str)+1) = c_null_char - end function c_string - subroutine launch_synchronous(process, args, stdin) class(process_type), intent(inout) :: process !> The command and arguments From 5b543a2859a3385d255857606a65c01115efb7a9 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 24 Dec 2024 12:04:52 +0100 Subject: [PATCH 04/52] use temporary `getfile` and `linalg_state_type` f --- src/stdlib_system_subprocess.F90 | 97 +++++++++++++++++++++++++++++++- 1 file changed, 96 insertions(+), 1 deletion(-) diff --git a/src/stdlib_system_subprocess.F90 b/src/stdlib_system_subprocess.F90 index c292d9963..7c3bfb7bd 100644 --- a/src/stdlib_system_subprocess.F90 +++ b/src/stdlib_system_subprocess.F90 @@ -2,8 +2,8 @@ module fortran_subprocess use iso_c_binding use iso_fortran_env, only: int64, real64 use stdlib_system - use stdlib_io, only: getfile use stdlib_strings, only: to_c_string + use stdlib_linalg_state, only: linalg_state_type, LINALG_ERROR, linalg_error_handling implicit none public @@ -417,5 +417,100 @@ function scratch_name(prefix) result(temp_filename) end function scratch_name + !> Helper function. + !> Reads a whole ASCII file and loads its contents into an allocatable character string.. + !> The function handles error states and optionally deletes the file after reading. + !> Temporarily uses `linalg_state_type` in lieu of the generalized `state_type`. + !> + !> Version: to be replaced after `getfile` is standardized in `stdlib_io`. + function getfile(fileName,err,delete) result(file) + !> Input file name + character(*), intent(in) :: fileName + !> [optional] State return flag. On error, if not requested, the code will stop. + type(linalg_state_type), optional, intent(out) :: err + !> [optional] Delete file after reading? Default: do not delete + logical, optional, intent(in) :: delete + !> Return as an allocatable string + character(:), allocatable :: file + + ! Local variables + type(linalg_state_type) :: err0 + character(len=:), allocatable :: fileString + character(len=512) :: iomsg + integer :: lun,iostat + integer(int64) :: errpos,fileSize + logical :: is_present,want_deleted + + ! Initializations + file = "" + + !> Check if the file should be deleted after reading + if (present(delete)) then + want_deleted = delete + else + want_deleted = .false. + end if + + !> Check file existing + inquire(file=fileName, exist=is_present) + if (.not.is_present) then + err0 = linalg_state_type('getfile',LINALG_ERROR,'File not present:',fileName) + call linalg_error_handling(err0,err) + return + end if + + !> Retrieve file size + inquire(file=fileName,size=fileSize) + + invalid_size: if (fileSize<0) then + + err0 = linalg_state_type('getfile',LINALG_ERROR,fileName,'has invalid size=',fileSize) + call linalg_error_handling(err0,err) + return + + endif invalid_size + + ! Read file + open(newunit=lun,file=fileName, & + form='unformatted',action='read',access='stream',status='old', & + iostat=iostat,iomsg=iomsg) + + if (iostat/=0) then + err0 = linalg_state_type('getfile',LINALG_ERROR,'Cannot open',fileName,'for read:',iomsg) + call linalg_error_handling(err0,err) + return + end if + + allocate(character(len=fileSize) :: fileString) + + read_data: if (fileSize>0) then + + read(lun, pos=1, iostat=iostat, iomsg=iomsg) fileString + + ! Read error + if (iostat/=0) then + + inquire(unit=lun,pos=errpos) + err0 = linalg_state_type('getfile',LINALG_ERROR,iomsg,'(',fileName,'at byte',errpos,')') + call linalg_error_handling(err0,err) + return + + endif + + end if read_data + + if (want_deleted) then + close(lun,iostat=iostat,status='delete') + if (iostat/=0) err0 = linalg_state_type('getfile',LINALG_ERROR,'Cannot delete',fileName,'after reading') + else + close(lun,iostat=iostat) + if (iostat/=0) err0 = linalg_state_type('getfile',LINALG_ERROR,'Cannot close',fileName,'after reading') + endif + + ! Process output + call move_alloc(from=fileString,to=file) + call linalg_error_handling(err0,err) + + end function getfile end module fortran_subprocess From 519d53df35cf05731df9fc4e82034ae2a5b51667 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 24 Dec 2024 12:40:31 +0100 Subject: [PATCH 05/52] implement `join` --- doc/specs/stdlib_strings.md | 44 +++++++++++++++++++ src/stdlib_strings.fypp | 87 ++++++++++++++++++++++++++++++++++++- 2 files changed, 129 insertions(+), 2 deletions(-) diff --git a/doc/specs/stdlib_strings.md b/doc/specs/stdlib_strings.md index 24980c3b0..6ef183eb2 100644 --- a/doc/specs/stdlib_strings.md +++ b/doc/specs/stdlib_strings.md @@ -459,8 +459,52 @@ The result is of the same type as `string`. {!example/strings/example_zfill.f90!} ``` + +### `join` + +#### Description + +Joins an array of strings into a single string. This function concatenates the strings from the input array, +inserting a separator between each string (default: space). A user-defined separator may be provided, The resulting string is returned. + + +#### Syntax + +`cmd = ` [[stdlib_strings(module):join(interface)]] ` (strings, separator)` + +#### Status + +Experimental + +#### Class + +Pure function + +#### Argument + +- `strings`: Array of strings (either `type(string_type)` or `character(len=*)`). + This argument is `intent(in)`. It is an array of strings that will be concatenated together. +- `separator`: Character scalar (optional). + This argument is `intent(in)`. It specifies the separator to be used between the strings. If not provided, the default separator (a space) is used. + +#### Result value + +The result is of the same type as the elements of `strings` (`type(string_type)` or `character(len=:), allocatable`). + +#### Example + +```fortran +! Example usage: +program test_join + type(string_type) :: result + type(string_type), dimension(3) :: words = [string_type('hello'), string_type('world'), string_type('fortran')] + result = join_string(words, ', ') ! Joins with comma and space + print *, result ! Output: "hello, world, fortran" +end program test_join +``` + ### `to_string` #### Description diff --git a/src/stdlib_strings.fypp b/src/stdlib_strings.fypp index 6beb875f3..6ec848294 100644 --- a/src/stdlib_strings.fypp +++ b/src/stdlib_strings.fypp @@ -5,7 +5,7 @@ !> The specification of this module is available [here](../page/specs/stdlib_strings.html). module stdlib_strings use stdlib_ascii, only: whitespace - use stdlib_string_type, only: string_type, char, verify, repeat, len + use stdlib_string_type, only: string_type, char, verify, repeat, len, len_trim, move use stdlib_optval, only: optval use stdlib_kinds, only: sp, dp, xdp, qp, int8, int16, int32, int64, lk, c_bool use iso_c_binding, only: c_char, c_null_char @@ -16,7 +16,7 @@ module stdlib_strings public :: to_c_string public :: strip, chomp public :: starts_with, ends_with - public :: slice, find, replace_all, padl, padr, count, zfill + public :: slice, find, replace_all, padl, padr, count, zfill, join !> Version: experimental !> @@ -166,6 +166,16 @@ module stdlib_strings module procedure :: zfill_char end interface zfill + !> Version: experimental + !> + !> Joins an array of strings into a single string. + !> The chunks are separated with a space, or an optional user-defined separator. + !> [Specifications](../page/specs/stdlib_strings.html#join) + interface join + module procedure :: join_string + module procedure :: join_char + end interface join + contains @@ -958,4 +968,77 @@ contains cstr(len(value)+1) = c_null_char end function to_c_string + !> Joins a list of strings with a separator (default: space). + !> Returns a new string + pure function join_string(strings, separator) result(cmd) + type(string_type), intent(in) :: strings(:) + character(len=*), intent(in), optional :: separator + type(string_type) :: cmd + + integer :: ltot, i, lt, pos + character(len=:), allocatable :: sep,cmd_char + + ! Determine separator: use user-provided separator or default space + if (present(separator)) then + sep = separator + else + sep = ' ' + end if + + ! Calculate the total length required, including separators + ltot = sum(len_trim(strings)) + (size(strings) - 1) * len(sep) + allocate(character(len=ltot) :: cmd_char) + + ! Concatenate strings with separator + pos = 0 + do i = 1, size(strings) + lt = len_trim(strings(i)) + cmd_char(pos+1:pos+lt) = char(strings(i),1,lt) + pos = pos + lt + if (i < size(strings)) then + cmd_char(pos+1:pos+len(sep)) = sep + pos = pos + len(sep) + end if + end do + + call move(from=cmd_char,to=cmd) + + end function join_string + + !> Joins a list of strings with a separator (default: space). + !> Returns a new string + pure function join_char(strings, separator) result(cmd) + character(*), intent(in) :: strings(:) + character(len=*), intent(in), optional :: separator + character(:), allocatable :: cmd + + integer :: ltot, i, lt, pos + character(len=:), allocatable :: sep + + ! Determine separator: use user-provided separator or default space + if (present(separator)) then + sep = separator + else + sep = ' ' + end if + + ! Calculate the total length required, including separators + ltot = sum(len_trim(strings)) + (size(strings) - 1) * len(sep) + allocate(character(len=ltot) :: cmd) + + cmd = repeat(' ',ltot) + + ! Concatenate strings with separator + pos = 0 + do i = 1, size(strings) + lt = len_trim(strings(i)) + cmd(pos+1:pos+lt) = strings(i)(1:lt) + pos = pos + lt + if (i < size(strings)) then + cmd(pos+1:pos+len(sep)) = sep + pos = pos + len(sep) + end if + end do + end function join_char + end module stdlib_strings From 1449b8da4a7f77d29cebbeb9ec947d1464523800 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 24 Dec 2024 12:43:35 +0100 Subject: [PATCH 06/52] fixes to build --- src/stdlib_system_subprocess.F90 | 81 +++++++++++++++++++++++++++++--- src/stdlib_system_subprocess.c | 13 +++++ 2 files changed, 87 insertions(+), 7 deletions(-) diff --git a/src/stdlib_system_subprocess.F90 b/src/stdlib_system_subprocess.F90 index 7c3bfb7bd..2e5ad3934 100644 --- a/src/stdlib_system_subprocess.F90 +++ b/src/stdlib_system_subprocess.F90 @@ -2,7 +2,7 @@ module fortran_subprocess use iso_c_binding use iso_fortran_env, only: int64, real64 use stdlib_system - use stdlib_strings, only: to_c_string + use stdlib_strings, only: to_c_string, join use stdlib_linalg_state, only: linalg_state_type, LINALG_ERROR, linalg_error_handling implicit none public @@ -59,6 +59,12 @@ subroutine process_wait(seconds) bind(C,name='process_wait') implicit none real(c_float), intent(in) :: seconds end subroutine process_wait + + type(c_ptr) function process_null_device(len) bind(C,name='process_null_device') + import c_ptr, c_int + implicit none + integer(c_int), intent(out) :: len + end function process_null_device end interface @@ -189,11 +195,11 @@ subroutine launch_asynchronous(process, args, stdin) character(c_char), dimension(:), allocatable, target :: c_cmd,c_stdin,c_stdin_file,c_stdout_file,c_stderr_file ! Assemble C strings - c_cmd = c_string(join(args)) - if (present(stdin)) c_stdin = c_string(stdin) - if (allocated(process%stdin_file)) c_stdin_file = c_string(process%stdin_file) - if (allocated(process%stdout_file)) c_stdout_file = c_string(process%stdout_file) - if (allocated(process%stderr_file)) c_stderr_file = c_string(process%stderr_file) + c_cmd = to_c_string(join(args)) + if (present(stdin)) c_stdin = to_c_string(stdin) + if (allocated(process%stdin_file)) c_stdin_file = to_c_string(process%stdin_file) + if (allocated(process%stdout_file)) c_stdout_file = to_c_string(process%stdout_file) + if (allocated(process%stderr_file)) c_stderr_file = to_c_string(process%stderr_file) ! On Windows, this 1) creates 2) launches an external process from C. ! On unix, this 1) forks an external process @@ -417,7 +423,68 @@ function scratch_name(prefix) result(temp_filename) end function scratch_name - !> Helper function. + + !> Assemble a single-line proces command line from a list of arguments. + !> + !> Version: Helper function. + function assemble_cmd(args, stdin, stdout, stderr) result(cmd) + !> Command to execute as a string + character(len=*), intent(in) :: args(:) + !> [optional] File name standard input (stdin) should be taken from + character(len=*), optional, intent(in) :: stdin + !> [optional] File name standard output (stdout) should be directed to + character(len=*), optional, intent(in) :: stdout + !> [optional] File name error output (stderr) should be directed to + character(len=*), optional, intent(in) :: stderr + + character(:), allocatable :: cmd,stdout_file,input_file,stderr_file + + if (present(stdin)) then + input_file = stdin + else + input_file = null_device() + end if + + if (present(stdout)) then + ! Redirect output to a file + stdout_file = stdout + else + stdout_file = null_device() + endif + + if (present(stderr)) then + stderr_file = stderr + else + stderr_file = null_device() + end if + + cmd = join(args)//" <"//input_file//" 1>"//stdout_file//" 2>"//stderr_file + + end function assemble_cmd + + !> Returns the file path of the null device for the current operating system. + !> + !> Version: Helper function. + function null_device() + character(:), allocatable :: null_device + + integer(c_int) :: i, len + type(c_ptr) :: c_path_ptr + character(kind=c_char), pointer :: c_path(:) + + ! Call the C function to get the null device path and its length + c_path_ptr = process_null_device(len) + call c_f_pointer(c_path_ptr,c_path,[len]) + + ! Allocate the Fortran string with the length returned from C + allocate(character(len=len) :: null_device) + + do concurrent (i=1:len) + null_device(i:i) = c_path(i) + end do + + end function null_device + !> Reads a whole ASCII file and loads its contents into an allocatable character string.. !> The function handles error states and optionally deletes the file after reading. !> Temporarily uses `linalg_state_type` in lieu of the generalized `state_type`. diff --git a/src/stdlib_system_subprocess.c b/src/stdlib_system_subprocess.c index 1d40e875b..29d09ef3c 100644 --- a/src/stdlib_system_subprocess.c +++ b/src/stdlib_system_subprocess.c @@ -2,6 +2,7 @@ #include #include #include +#include #ifdef _WIN32 #include @@ -250,3 +251,15 @@ void process_wait(float seconds) usleep(uSeconds); #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 +} From cf35194b96dd8feaf72b9a1992a648a903aa485d Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 24 Dec 2024 13:00:05 +0100 Subject: [PATCH 07/52] create submodule --- src/stdlib_system.F90 | 97 +++++++++++++++++++++++++++++++- src/stdlib_system_subprocess.F90 | 92 +++++++----------------------- 2 files changed, 116 insertions(+), 73 deletions(-) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 7bcc78baf..e8b15628d 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -1,9 +1,101 @@ module stdlib_system -use, intrinsic :: iso_c_binding, only : c_int, c_long +use, intrinsic :: iso_c_binding, only : c_int, c_long, c_null_ptr, c_int64_t +use, intrinsic :: iso_c_binding, only : process_handle => c_ptr, null_process => c_null_ptr +use stdlib_kinds, only: int64, dp implicit none private public :: sleep +!> Public sub-processing interface +public :: run +public :: process_type +public :: is_completed +public :: is_running + +! CPU clock ticks storage +integer, parameter, private :: TICKS = int64 +integer, parameter, private :: RTICKS = dp + +! Interoperable types to the C backend +integer, parameter, public :: process_ID = c_int64_t + +! Default flag for the runner process +integer(process_ID), parameter, private :: FORKED_PROCESS = 0_process_ID + +! Public type to describe a process +type :: process_type + + !> Process ID (if external); 0 if run by the program process + integer(process_ID) :: id = FORKED_PROCESS + type(process_handle) :: handle = null_process + + !> Process is completed + logical :: completed = .false. + integer(TICKS) :: start_time = 0 + + !> Process exit code + integer :: exit_code = 0 + + !> Stdin file name + character(:), allocatable :: stdin_file + + !> Standard output + character(:), allocatable :: stdout_file + character(:), allocatable :: stdout + + !> Error output + character(:), allocatable :: stderr_file + character(:), allocatable :: stderr + + !> Store time at the last update + integer(TICKS) :: last_update = 0 + +end type process_type + +interface run + !> Open a new, asynchronous process + module type(process_type) function process_open(args,wait,stdin,want_stdout,want_stderr) result(process) + !> The command and arguments + character(*), intent(in) :: args(:) + !> Optional character input to be sent to the process via pipe + character(*), optional, intent(in) :: stdin + !> Define if the process should be synchronous (wait=.true.), or asynchronous(wait=.false.) + logical, optional, intent(in) :: wait + !> Require collecting output + logical, optional, intent(in) :: want_stdout, want_stderr + end function process_open +end interface run + +!> Live check if a process is still running +interface is_running + module logical function process_is_running(process) result(is_running) + class(process_type), intent(inout) :: process + end function process_is_running +end interface is_running + +!> Live check if a process is still running +interface is_completed + module logical function process_is_completed(process) result(is_completed) + class(process_type), intent(inout) :: process + end function process_is_completed +end interface is_completed + +!> Return process lifetime so far, in seconds +interface elapsed + module real(RTICKS) function process_lifetime(process) result(delta_t) + class(process_type), intent(in) :: process + end function process_lifetime +end interface elapsed + +!> Wait until a running process is completed +interface wait + module subroutine wait_for_completion(process, max_wait_time) + class(process_type), intent(inout) :: process + ! Optional max wait time in seconds + real, optional, intent(in) :: max_wait_time + end subroutine wait_for_completion +end interface wait + interface #ifdef _WIN32 subroutine winsleep(dwMilliseconds) bind (C, name='Sleep') @@ -26,6 +118,9 @@ end function usleep #endif end interface + + + contains subroutine sleep(millisec) diff --git a/src/stdlib_system_subprocess.F90 b/src/stdlib_system_subprocess.F90 index 2e5ad3934..f6c03e862 100644 --- a/src/stdlib_system_subprocess.F90 +++ b/src/stdlib_system_subprocess.F90 @@ -1,38 +1,27 @@ -module fortran_subprocess +submodule (stdlib_system) stdlib_system_subprocess use iso_c_binding use iso_fortran_env, only: int64, real64 use stdlib_system use stdlib_strings, only: to_c_string, join use stdlib_linalg_state, only: linalg_state_type, LINALG_ERROR, linalg_error_handling - implicit none - public + implicit none(type, external) - ! Interoperable types - integer, parameter, public :: pid_t = c_int64_t - - logical(c_bool), parameter, private :: C_FALSE = .false._c_bool - logical(c_bool), parameter, private :: C_TRUE = .true._c_bool - - ! CPU clock ticks range - integer, parameter, private :: TICKS = int64 - integer, parameter, private :: RTICKS = real64 + logical(c_bool), parameter :: C_FALSE = .false._c_bool + logical(c_bool), parameter :: C_TRUE = .true._c_bool ! Number of CPU ticks between status updates integer(TICKS), parameter :: CHECK_EVERY_TICKS = 100 - ! Default flag for the runner process - integer(pid_t), parameter :: FORKED_PROCESS = 0_pid_t - ! Interface to C support functions from stdlib_system_subprocess.c interface ! C wrapper to query process status subroutine process_query_status(pid, wait, is_running, exit_code) & bind(C, name='process_query_status') - import c_int, c_bool, pid_t + import c_int, c_bool, process_ID implicit none ! Process ID - integer(pid_t), value :: pid + integer(process_ID), value :: pid ! Whether to wait for process completion logical(c_bool), value :: wait ! Whether the process is still running @@ -43,7 +32,7 @@ end subroutine process_query_status subroutine process_create(cmd, stdin_stream, stdin_file, stdout_file, stderr_file, handle, pid) & bind(C, name='process_create') - import c_char, c_ptr, pid_t + import c_char, c_ptr, process_ID implicit none character(c_char), intent(in) :: cmd(*) character(c_char), intent(in), optional :: stdin_stream(*) @@ -51,7 +40,7 @@ subroutine process_create(cmd, stdin_stream, stdin_file, stdout_file, stderr_fil character(c_char), intent(in), optional :: stdout_file(*) character(c_char), intent(in), optional :: stderr_file(*) type(c_ptr) , intent(out) :: handle - integer(pid_t), intent(out) :: pid + integer(process_ID), intent(out) :: pid end subroutine process_create subroutine process_wait(seconds) bind(C,name='process_wait') @@ -68,52 +57,13 @@ end function process_null_device end interface - type, public :: process_type - - !> Process ID (if external); 0 if run by the program process - integer(pid_t) :: id = FORKED_PROCESS - type(c_ptr) :: handle = c_null_ptr - - !> Process is completed - logical :: completed = .false. - integer(TICKS) :: start_time = 0 - - !> Process exit code - integer :: exit_code = 0 - - !> Stdin file name - character(:), allocatable :: stdin_file - - !> Standard output - character(:), allocatable :: stdout_file - character(:), allocatable :: stdout - - !> Error output - character(:), allocatable :: stderr_file - character(:), allocatable :: stderr - - !> Store time at the last update - integer(TICKS) :: last_update = 0 - - contains - - !> Return process lifetime so far, in seconds - procedure :: elapsed => process_lifetime - - !> Live check if a process is still running - procedure :: is_running => process_is_running - procedure :: is_completed => process_is_completed - - !> Wait until a running process is completed - procedure :: wait => wait_for_completion - - end type process_type + contains !> Open a new, asynchronous process - type(process_type) function process_open(args,wait,stdin,want_stdout,want_stderr) result(process) + module type(process_type) function process_open(args,wait,stdin,want_stdout,want_stderr) result(process) !> The command and arguments character(*), intent(in) :: args(:) !> Optional character input to be sent to the process via pipe @@ -178,8 +128,6 @@ type(process_type) function process_open(args,wait,stdin,want_stdout,want_stderr endif - - ! Run a first update call update_process_state(process) @@ -249,7 +197,7 @@ subroutine launch_synchronous(process, args, stdin) end subroutine launch_synchronous !> Return the current (or total) process lifetime, in seconds - real(RTICKS) function process_lifetime(process) result(delta_t) + module real(RTICKS) function process_lifetime(process) result(delta_t) class(process_type), intent(in) :: process real(RTICKS) :: ticks_per_second @@ -271,7 +219,7 @@ real(RTICKS) function process_lifetime(process) result(delta_t) end function process_lifetime !> Wait for a process to be completed - subroutine wait_for_completion(process, max_wait_time) + module subroutine wait_for_completion(process, max_wait_time) class(process_type), intent(inout) :: process ! Optional max wait time in seconds real, optional, intent(in) :: max_wait_time @@ -310,7 +258,7 @@ subroutine update_process_state(process) real(RTICKS) :: count_rate integer(TICKS) :: count_max,current_time - logical(c_bool) :: is_running + logical(c_bool) :: running integer(c_int) :: exit_code ! If the process has completed, should not be queried again @@ -328,9 +276,9 @@ subroutine update_process_state(process) if (process%id /= FORKED_PROCESS) then ! Query process state - call process_query_status(process%id, wait=C_FALSE, is_running=is_running, exit_code=exit_code) + call process_query_status(process%id, wait=C_FALSE, is_running=running, exit_code=exit_code) - process%completed = .not.is_running + process%completed = .not.running if (process%completed) then ! Process completed, may have returned an error code @@ -346,7 +294,7 @@ subroutine save_completed_state(process,delete_files) type(process_type), intent(inout) :: process logical, intent(in) :: delete_files - logical(c_bool) :: is_running + logical(c_bool) :: running integer(c_int) :: exit_code integer :: delete @@ -354,7 +302,7 @@ subroutine save_completed_state(process,delete_files) process%completed = .true. ! Clean up process state using waitpid - if (process%id/=FORKED_PROCESS) call process_query_status(process%id, C_TRUE, is_running, exit_code) + if (process%id/=FORKED_PROCESS) call process_query_status(process%id, C_TRUE, running, exit_code) ! Process is over: load stdout/stderr if requested if (allocated(process%stderr_file)) then @@ -376,7 +324,7 @@ subroutine save_completed_state(process,delete_files) end subroutine save_completed_state !> Live check if a process is running - logical function process_is_running(process) result(is_running) + module logical function process_is_running(process) result(is_running) class(process_type), intent(inout) :: process ! Each evaluation triggers a state update @@ -387,7 +335,7 @@ logical function process_is_running(process) result(is_running) end function process_is_running !> Live check if a process has completed - logical function process_is_completed(process) result(is_completed) + module logical function process_is_completed(process) result(is_completed) class(process_type), intent(inout) :: process ! Each evaluation triggers a state update @@ -580,4 +528,4 @@ function getfile(fileName,err,delete) result(file) end function getfile -end module fortran_subprocess +end submodule stdlib_system_subprocess From e8451b2267a6877c616e1f89d45569c380717efc Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 24 Dec 2024 13:06:33 +0100 Subject: [PATCH 08/52] unify `sleep` interface --- src/stdlib_system.F90 | 50 +++++++------------------------- src/stdlib_system_subprocess.F90 | 23 ++++++++++----- 2 files changed, 25 insertions(+), 48 deletions(-) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index e8b15628d..99b20c6e2 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -96,49 +96,19 @@ module subroutine wait_for_completion(process, max_wait_time) end subroutine wait_for_completion end interface wait -interface -#ifdef _WIN32 -subroutine winsleep(dwMilliseconds) bind (C, name='Sleep') -!! version: experimental -!! -!! void Sleep(DWORD dwMilliseconds) -!! https://docs.microsoft.com/en-us/windows/win32/api/synchapi/nf-synchapi-sleep -import c_long -integer(c_long), value, intent(in) :: dwMilliseconds -end subroutine winsleep -#else -integer(c_int) function usleep(usec) bind (C) -!! version: experimental -!! -!! int usleep(useconds_t usec); -!! https://linux.die.net/man/3/usleep -import c_int -integer(c_int), value, intent(in) :: usec -end function usleep -#endif +!> Query the system to update a process's state +interface update + module subroutine update_process_state(process) + type(process_type), intent(inout) :: process + end subroutine update_process_state end interface - - - -contains - -subroutine sleep(millisec) !! version: experimental !! -integer, intent(in) :: millisec -integer(c_int) :: ierr - -#ifdef _WIN32 -!! PGI Windows, Ifort Windows, .... -call winsleep(int(millisec, c_long)) -#else -!! Linux, Unix, MacOS, MSYS2, ... -ierr = usleep(int(millisec * 1000, c_int)) -if (ierr/=0) error stop 'problem with usleep() system call' -#endif - - -end subroutine sleep +interface sleep + module subroutine sleep(millisec) + integer, intent(in) :: millisec + end subroutine sleep +end interface sleep end module stdlib_system diff --git a/src/stdlib_system_subprocess.F90 b/src/stdlib_system_subprocess.F90 index f6c03e862..c67b1bb13 100644 --- a/src/stdlib_system_subprocess.F90 +++ b/src/stdlib_system_subprocess.F90 @@ -32,23 +32,25 @@ end subroutine process_query_status subroutine process_create(cmd, stdin_stream, stdin_file, stdout_file, stderr_file, handle, pid) & bind(C, name='process_create') - import c_char, c_ptr, process_ID + import c_char, process_handle, process_ID implicit none character(c_char), intent(in) :: cmd(*) character(c_char), intent(in), optional :: stdin_stream(*) character(c_char), intent(in), optional :: stdin_file(*) character(c_char), intent(in), optional :: stdout_file(*) character(c_char), intent(in), optional :: stderr_file(*) - type(c_ptr) , intent(out) :: handle + type(process_handle), intent(out) :: handle integer(process_ID), intent(out) :: pid end subroutine process_create + ! 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 + ! Return path to the null device type(c_ptr) function process_null_device(len) bind(C,name='process_null_device') import c_ptr, c_int implicit none @@ -57,11 +59,16 @@ end function process_null_device end interface - - - contains + ! Call system-dependent wait implementation + module subroutine sleep(millisec) + integer, intent(in) :: millisec + + call process_wait(real(0.001*millisec,c_float)) + + end subroutine sleep + !> Open a new, asynchronous process module type(process_type) function process_open(args,wait,stdin,want_stdout,want_stderr) result(process) !> The command and arguments @@ -243,7 +250,7 @@ module subroutine wait_for_completion(process, max_wait_time) wait_loop: do while (process_is_running(process) .and. elapsed <= wait_time) ! Small sleep to avoid CPU hogging (1 ms) - call process_wait(0.001_c_float) + call sleep(1) call system_clock(current_time) elapsed = real(current_time - start_time, RTICKS) / count_rate @@ -253,8 +260,8 @@ module subroutine wait_for_completion(process, max_wait_time) end subroutine wait_for_completion !> Update a process's state, and - subroutine update_process_state(process) - class(process_type), intent(inout) :: process + module subroutine update_process_state(process) + type(process_type), intent(inout) :: process real(RTICKS) :: count_rate integer(TICKS) :: count_max,current_time From 48da380f0c7eb31f990f101e18096530c9e609a2 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 24 Dec 2024 15:27:05 +0100 Subject: [PATCH 09/52] add single-command `run` API --- src/stdlib_system.F90 | 25 ++++++++++++++++++------- src/stdlib_system_subprocess.F90 | 21 ++++++++++++++++++--- 2 files changed, 36 insertions(+), 10 deletions(-) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 99b20c6e2..a2a5e3d31 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -11,6 +11,8 @@ module stdlib_system public :: process_type public :: is_completed public :: is_running +public :: update +public :: wait ! CPU clock ticks storage integer, parameter, private :: TICKS = int64 @@ -33,9 +35,6 @@ module stdlib_system logical :: completed = .false. integer(TICKS) :: start_time = 0 - !> Process exit code - integer :: exit_code = 0 - !> Stdin file name character(:), allocatable :: stdin_file @@ -44,6 +43,7 @@ module stdlib_system character(:), allocatable :: stdout !> Error output + integer :: exit_code = 0 character(:), allocatable :: stderr_file character(:), allocatable :: stderr @@ -53,8 +53,19 @@ module stdlib_system end type process_type interface run - !> Open a new, asynchronous process - module type(process_type) function process_open(args,wait,stdin,want_stdout,want_stderr) result(process) + !> Open a new process from a command line + module type(process_type) function process_open_cmd(cmd,wait,stdin,want_stdout,want_stderr) result(process) + !> The command and arguments + character(*), intent(in) :: cmd + !> Optional character input to be sent to the process via pipe + character(*), optional, intent(in) :: stdin + !> Define if the process should be synchronous (wait=.true.), or asynchronous(wait=.false.) + logical, optional, intent(in) :: wait + !> Require collecting output + logical, optional, intent(in) :: want_stdout, want_stderr + end function process_open_cmd + !> Open a new, asynchronous process from a list of arguments + module type(process_type) function process_open_args(args,wait,stdin,want_stdout,want_stderr) result(process) !> The command and arguments character(*), intent(in) :: args(:) !> Optional character input to be sent to the process via pipe @@ -63,7 +74,7 @@ module type(process_type) function process_open(args,wait,stdin,want_stdout,want logical, optional, intent(in) :: wait !> Require collecting output logical, optional, intent(in) :: want_stdout, want_stderr - end function process_open + end function process_open_args end interface run !> Live check if a process is still running @@ -101,7 +112,7 @@ end subroutine wait_for_completion module subroutine update_process_state(process) type(process_type), intent(inout) :: process end subroutine update_process_state -end interface +end interface update !! version: experimental !! diff --git a/src/stdlib_system_subprocess.F90 b/src/stdlib_system_subprocess.F90 index c67b1bb13..dcf40f538 100644 --- a/src/stdlib_system_subprocess.F90 +++ b/src/stdlib_system_subprocess.F90 @@ -69,8 +69,23 @@ module subroutine sleep(millisec) end subroutine sleep - !> Open a new, asynchronous process - module type(process_type) function process_open(args,wait,stdin,want_stdout,want_stderr) result(process) + !> Open a new process + module type(process_type) function process_open_cmd(cmd,wait,stdin,want_stdout,want_stderr) result(process) + !> The command and arguments + character(*), intent(in) :: cmd + !> Optional character input to be sent to the process via pipe + character(*), optional, intent(in) :: stdin + !> Define if the process should be synchronous (wait=.true.), or asynchronous(wait=.false.) + logical, optional, intent(in) :: wait + !> Require collecting output + logical, optional, intent(in) :: want_stdout, want_stderr + + process = process_open_args([cmd],wait,stdin,want_stdout,want_stderr) + + end function process_open_cmd + + !> Open a new process + module type(process_type) function process_open_args(args,wait,stdin,want_stdout,want_stderr) result(process) !> The command and arguments character(*), intent(in) :: args(:) !> Optional character input to be sent to the process via pipe @@ -138,7 +153,7 @@ module type(process_type) function process_open(args,wait,stdin,want_stdout,want ! Run a first update call update_process_state(process) - end function process_open + end function process_open_args subroutine launch_asynchronous(process, args, stdin) class(process_type), intent(inout) :: process From 1f4de32713855001843088ac98109dea74f59fbc Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 24 Dec 2024 15:27:11 +0100 Subject: [PATCH 10/52] add tests --- test/system/CMakeLists.txt | 1 + test/system/test_subprocess.f90 | 100 ++++++++++++++++++++++++++++++++ 2 files changed, 101 insertions(+) create mode 100644 test/system/test_subprocess.f90 diff --git a/test/system/CMakeLists.txt b/test/system/CMakeLists.txt index 3e8f0369f..7dcc8060b 100644 --- a/test/system/CMakeLists.txt +++ b/test/system/CMakeLists.txt @@ -1 +1,2 @@ ADDTEST(sleep) +ADDTEST(subprocess) diff --git a/test/system/test_subprocess.f90 b/test/system/test_subprocess.f90 new file mode 100644 index 000000000..b11717b30 --- /dev/null +++ b/test/system/test_subprocess.f90 @@ -0,0 +1,100 @@ +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 + + 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_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, wait=.true., want_stdout=.true.) + call check(error, process%completed) + if (allocated(error)) return + + call check(error, trim(process%stdout) == "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 + character(len=*), parameter :: command = "sleep 1" + + process = run(command, wait=.false.) + call check(error, .not. process%completed) + if (allocated(error)) return + + running = is_running(process) + call check(error, running) + if (allocated(error)) return + + call wait(process) + call check(error, process%completed) + end subroutine test_run_asynchronous + + !> 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, wait=.true., 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) + if (allocated(error)) return + + call check(error, trim(process%stdout) == "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 From 6fbc2e6fe61bf96b9abf14a2c6e56ab5da0a2404 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 24 Dec 2024 15:38:46 +0100 Subject: [PATCH 11/52] getfile: remove trailing new line characters --- src/stdlib_system_subprocess.F90 | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/src/stdlib_system_subprocess.F90 b/src/stdlib_system_subprocess.F90 index dcf40f538..ea38c01cb 100644 --- a/src/stdlib_system_subprocess.F90 +++ b/src/stdlib_system_subprocess.F90 @@ -471,9 +471,11 @@ function getfile(fileName,err,delete) result(file) character(:), allocatable :: file ! Local variables + character(*), parameter :: CRLF = achar(13)//new_line('a') type(linalg_state_type) :: err0 character(len=:), allocatable :: fileString character(len=512) :: iomsg + character :: last_char integer :: lun,iostat integer(int64) :: errpos,fileSize logical :: is_present,want_deleted @@ -517,6 +519,27 @@ function getfile(fileName,err,delete) result(file) call linalg_error_handling(err0,err) return end if + + remove_trailing_newline: if (fileSize>0) then + + last_char = CRLF(1:1) + fileSize = fileSize+1 + + do while (scan(last_char,CRLF)>0 .and. fileSize>1) + fileSize = fileSize-1 + read(lun, pos=fileSize, iostat=iostat, iomsg=iomsg) last_char + + ! Read error + if (iostat/=0) then + + err0 = linalg_state_type('getfile',LINALG_ERROR,iomsg,'(',fileName,'at byte',fileSize,')') + call linalg_error_handling(err0,err) + return + + endif + + end do + endif remove_trailing_newline allocate(character(len=fileSize) :: fileString) From f9bf30411ba8711e31074c11eacfbcd7fd8ab375 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 24 Dec 2024 16:01:30 +0100 Subject: [PATCH 12/52] fix tests to be cross-platform --- src/stdlib_system.F90 | 9 +++++++++ src/stdlib_system_subprocess.F90 | 13 +++++++++++++ src/stdlib_system_subprocess.c | 11 +++++++++++ test/system/test_subprocess.f90 | 32 ++++++++++++++++++++++---------- 4 files changed, 55 insertions(+), 10 deletions(-) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index a2a5e3d31..803d54c8e 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -13,6 +13,8 @@ module stdlib_system public :: is_running public :: update public :: wait +public :: elapsed +public :: has_win32 ! CPU clock ticks storage integer, parameter, private :: TICKS = int64 @@ -122,4 +124,11 @@ module subroutine sleep(millisec) end subroutine sleep end interface sleep +!! version: experimental +!! +interface + module logical function has_win32() + end function has_win32 +end interface + end module stdlib_system diff --git a/src/stdlib_system_subprocess.F90 b/src/stdlib_system_subprocess.F90 index ea38c01cb..ff164fd04 100644 --- a/src/stdlib_system_subprocess.F90 +++ b/src/stdlib_system_subprocess.F90 @@ -56,6 +56,12 @@ type(c_ptr) function process_null_device(len) bind(C,name='process_null_device') implicit none integer(c_int), intent(out) :: len end function process_null_device + + ! Utility: check if _WIN32 is defined in the C compiler + logical(c_bool) function process_has_win32() bind(C,name='process_has_win32') + import c_bool + implicit none + end function process_has_win32 end interface @@ -455,6 +461,13 @@ function null_device() end function null_device + !> Returns the file path of the null device for the current operating system. + !> + !> Version: Helper function. + module logical function has_win32() + has_win32 = logical(process_has_win32()) + end function has_win32 + !> Reads a whole ASCII file and loads its contents into an allocatable character string.. !> The function handles error states and optionally deletes the file after reading. !> Temporarily uses `linalg_state_type` in lieu of the generalized `state_type`. diff --git a/src/stdlib_system_subprocess.c b/src/stdlib_system_subprocess.c index 29d09ef3c..f0d52bd54 100644 --- a/src/stdlib_system_subprocess.c +++ b/src/stdlib_system_subprocess.c @@ -263,3 +263,14 @@ const char* process_null_device(int* len) return "/dev/null"; #endif } + +// Returns a boolean flag if macro _WIN32 is defined +bool process_has_win32() +{ +#ifdef _WIN32 + return true; +#else + return false; +#endif // _WIN32 +} + diff --git a/test/system/test_subprocess.f90 b/test/system/test_subprocess.f90 index b11717b30..8b3414a53 100644 --- a/test/system/test_subprocess.f90 +++ b/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 + use stdlib_system, only: process_type, run, is_running, wait, update, elapsed, has_win32 implicit none @@ -27,8 +27,8 @@ subroutine test_run_synchronous(error) process = run(command, wait=.true., want_stdout=.true.) call check(error, process%completed) if (allocated(error)) return - - call check(error, trim(process%stdout) == "Hello") + + call check(error, trim(process%stdout) == "Hello", "stdout=<"//trim(process%stdout)//">, expected ") end subroutine test_run_synchronous !> Test running an asynchronous process @@ -36,18 +36,27 @@ subroutine test_run_asynchronous(error) type(error_type), allocatable, intent(out) :: error type(process_type) :: process logical :: running - character(len=*), parameter :: command = "sleep 1" - process = run(command, wait=.false.) - call check(error, .not. process%completed) + ! The closest possible to a cross-platform command that waits + if (has_win32()) then + process = run("ping -n 2 127.0.0.1", wait=.false.) + else + process = run("ping -c 2 127.0.0.1", wait=.false.) + 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) + 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) + 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 updating and checking process state @@ -62,10 +71,13 @@ subroutine test_process_state(error) call check(error, process%completed) if (allocated(error)) return - call check(error, process%exit_code == 0) + 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") + call check(error, trim(process%stdout) == "Testing", "stdout=<"//trim(process%stdout)//">, expected ") if (allocated(error)) return end subroutine test_process_state From 71facb39781bece6612f01475ea2cbe0e2dc2391 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 24 Dec 2024 16:31:41 +0100 Subject: [PATCH 13/52] use `nanosleep` rather than `usleep` --- src/stdlib_system_subprocess.c | 32 +++++++++++++++++++++++++++++++- 1 file changed, 31 insertions(+), 1 deletion(-) diff --git a/src/stdlib_system_subprocess.c b/src/stdlib_system_subprocess.c index f0d52bd54..eecd07fec 100644 --- a/src/stdlib_system_subprocess.c +++ b/src/stdlib_system_subprocess.c @@ -1,5 +1,6 @@ #include #include +#include #include #include #include @@ -9,6 +10,8 @@ #else #include #include +#include +#include #endif // _WIN32 // Typedefs @@ -248,7 +251,34 @@ void process_wait(float seconds) Sleep(dwMilliseconds); #else int uSeconds = (int) 1.0e6*seconds; - usleep(uSeconds); + + struct timespec t; + + t.tv_sec = seconds; + t.tv_nsec = seconds * 1000000; + + int ierr = nanosleep(&t, NULL); + + 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() bad milliseconds value\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 } From 6ea72d1ec9f2fbd8fb2ee8d2bad23c7537e16ab5 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 24 Dec 2024 16:31:51 +0100 Subject: [PATCH 14/52] add examples --- example/CMakeLists.txt | 1 + example/system/CMakeLists.txt | 3 +++ example/system/example_process_1.f90 | 20 ++++++++++++++++++++ example/system/example_process_2.f90 | 21 +++++++++++++++++++++ example/system/example_process_3.f90 | 22 ++++++++++++++++++++++ 5 files changed, 67 insertions(+) create mode 100644 example/system/CMakeLists.txt create mode 100644 example/system/example_process_1.f90 create mode 100644 example/system/example_process_2.f90 create mode 100644 example/system/example_process_3.f90 diff --git a/example/CMakeLists.txt b/example/CMakeLists.txt index cbef7f075..0abd204a7 100644 --- a/example/CMakeLists.txt +++ b/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) diff --git a/example/system/CMakeLists.txt b/example/system/CMakeLists.txt new file mode 100644 index 000000000..878014cb3 --- /dev/null +++ b/example/system/CMakeLists.txt @@ -0,0 +1,3 @@ +ADD_EXAMPLE(process_1) +ADD_EXAMPLE(process_2) +ADD_EXAMPLE(process_3) diff --git a/example/system/example_process_1.f90 b/example/system/example_process_1.f90 new file mode 100644 index 000000000..b1dbe113d --- /dev/null +++ b/example/system/example_process_1.f90 @@ -0,0 +1,20 @@ +! Process example 1: Run a Command Synchronously and Capture Output +program run_sync + use stdlib_system, only: run, is_completed, process_type + implicit none + + type(process_type) :: p + logical :: completed + + ! Run a synchronous process to list directory contents + p = run("ls -l", wait=.true., want_stdout=.true.) + + ! 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 diff --git a/example/system/example_process_2.f90 b/example/system/example_process_2.f90 new file mode 100644 index 000000000..37ce3efd2 --- /dev/null +++ b/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, run, is_running, wait + implicit none + + type(process_type) :: p + + ! Run an asynchronous process to sleep for 5 seconds + p = run("sleep 3", wait=.false.) + + ! 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) + print *, "Process has now completed." +end program run_async diff --git a/example/system/example_process_3.f90 b/example/system/example_process_3.f90 new file mode 100644 index 000000000..9be919d3f --- /dev/null +++ b/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 + p = run(args, wait=.true.) + + ! Print the runtime of the process + print *, "Process runtime:", elapsed(p), "seconds." + + ! Clean up + deallocate(args) +end program run_with_args From e35b37aee4c2834f1658f35226057de31d90102e Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 24 Dec 2024 16:47:46 +0100 Subject: [PATCH 15/52] `kill` process --- src/stdlib_system.F90 | 10 ++++++ src/stdlib_system_subprocess.F90 | 43 +++++++++++++++++++++-- src/stdlib_system_subprocess.c | 58 ++++++++++++++++++++++++++++++++ test/system/test_subprocess.f90 | 37 +++++++++++++++++++- 4 files changed, 145 insertions(+), 3 deletions(-) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 803d54c8e..00f605499 100644 --- a/src/stdlib_system.F90 +++ b/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 diff --git a/src/stdlib_system_subprocess.F90 b/src/stdlib_system_subprocess.F90 index ff164fd04..9dee9e797 100644 --- a/src/stdlib_system_subprocess.F90 +++ b/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 diff --git a/src/stdlib_system_subprocess.c b/src/stdlib_system_subprocess.c index eecd07fec..5d9386a22 100644 --- a/src/stdlib_system_subprocess.c +++ b/src/stdlib_system_subprocess.c @@ -12,6 +12,7 @@ #include #include #include +#include #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) { diff --git a/test/system/test_subprocess.f90 b/test/system/test_subprocess.f90 index 8b3414a53..1da80adaf 100644 --- a/test/system/test_subprocess.f90 +++ b/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 From 237e9ffb0316fce3fecdb148fd32861c9e442982 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 24 Dec 2024 16:49:52 +0100 Subject: [PATCH 16/52] add process killing example --- example/system/CMakeLists.txt | 1 + example/system/example_process_4.f90 | 34 ++++++++++++++++++++++++++++ 2 files changed, 35 insertions(+) create mode 100644 example/system/example_process_4.f90 diff --git a/example/system/CMakeLists.txt b/example/system/CMakeLists.txt index 878014cb3..87a76a5a0 100644 --- a/example/system/CMakeLists.txt +++ b/example/system/CMakeLists.txt @@ -1,3 +1,4 @@ ADD_EXAMPLE(process_1) ADD_EXAMPLE(process_2) ADD_EXAMPLE(process_3) +ADD_EXAMPLE(process_4) diff --git a/example/system/example_process_4.f90 b/example/system/example_process_4.f90 new file mode 100644 index 000000000..a1c5bad9e --- /dev/null +++ b/example/system/example_process_4.f90 @@ -0,0 +1,34 @@ +! Process example 4: Kill a running process +program example_process_kill + use stdlib_system, only: process_type, run, is_running, kill, elapsed, has_win32, sleep + implicit none + type(process_type) :: process + logical :: running, success + + print *, "Starting a long-running process..." + 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 + + ! Verify the process is running + running = is_running(process) + print *, "Process running:", running + + ! Wait a bit before killing the process + call sleep(millisec=1250) ! Portable subroutine for sleeping + + 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 From 2c58fcab685b3396f64fcbf5c9905f3886f4018f Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 24 Dec 2024 10:18:42 -0600 Subject: [PATCH 17/52] on Windows, redirect to `NUL` if output not requested --- src/stdlib_system_subprocess.c | 26 +++++++++++++++++++------- 1 file changed, 19 insertions(+), 7 deletions(-) diff --git a/src/stdlib_system_subprocess.c b/src/stdlib_system_subprocess.c index 5d9386a22..0a4bf00ce 100644 --- a/src/stdlib_system_subprocess.c +++ b/src/stdlib_system_subprocess.c @@ -57,28 +57,40 @@ void process_create_windows(const char* cmd, const char* stdin_stream, fclose(stdin_fp); } - // Open stdout file if provided + // 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; } - si.hStdOutput = hStdout; - si.dwFlags |= STARTF_USESTDHANDLES; + } 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 + // 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; } - si.hStdError = hStderr; - si.dwFlags |= STARTF_USESTDHANDLES; + } 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[4096]; if (stdin_file) { From 136b5b83f77826d701996d0af3106639956f7440 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 25 Dec 2024 16:09:56 +0100 Subject: [PATCH 18/52] remove unused process handle --- src/stdlib_system.F90 | 4 +--- src/stdlib_system_subprocess.F90 | 7 +++---- src/stdlib_system_subprocess.c | 13 +++++-------- 3 files changed, 9 insertions(+), 15 deletions(-) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 00f605499..314fb9f5b 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -1,6 +1,5 @@ module stdlib_system use, intrinsic :: iso_c_binding, only : c_int, c_long, c_null_ptr, c_int64_t -use, intrinsic :: iso_c_binding, only : process_handle => c_ptr, null_process => c_null_ptr use stdlib_kinds, only: int64, dp implicit none private @@ -27,12 +26,11 @@ module stdlib_system ! Default flag for the runner process integer(process_ID), parameter, private :: FORKED_PROCESS = 0_process_ID -! Public type to describe a process +!> Process type holding process information and the connected stdout, stderr, stdin units type :: process_type !> Process ID (if external); 0 if run by the program process integer(process_ID) :: id = FORKED_PROCESS - type(process_handle) :: handle = null_process !> Process is completed logical :: completed = .false. diff --git a/src/stdlib_system_subprocess.F90 b/src/stdlib_system_subprocess.F90 index 9dee9e797..cfeb9b8f3 100644 --- a/src/stdlib_system_subprocess.F90 +++ b/src/stdlib_system_subprocess.F90 @@ -30,16 +30,15 @@ subroutine process_query_status(pid, wait, is_running, exit_code) & integer(c_int), intent(out) :: exit_code end subroutine process_query_status - subroutine process_create(cmd, stdin_stream, stdin_file, stdout_file, stderr_file, handle, pid) & + subroutine process_create(cmd, stdin_stream, stdin_file, stdout_file, stderr_file, pid) & bind(C, name='process_create') - import c_char, process_handle, process_ID + import c_char, process_ID implicit none character(c_char), intent(in) :: cmd(*) character(c_char), intent(in), optional :: stdin_stream(*) character(c_char), intent(in), optional :: stdin_file(*) character(c_char), intent(in), optional :: stdout_file(*) character(c_char), intent(in), optional :: stderr_file(*) - type(process_handle), intent(out) :: handle integer(process_ID), intent(out) :: pid end subroutine process_create @@ -185,7 +184,7 @@ subroutine launch_asynchronous(process, args, stdin) ! On Windows, this 1) creates 2) launches an external process from C. ! On unix, this 1) forks an external process - call process_create(c_cmd, c_stdin, c_stdin_file, c_stdout_file, c_stderr_file, process%handle, process%id) + call process_create(c_cmd, c_stdin, c_stdin_file, c_stdout_file, c_stderr_file, process%id) end subroutine launch_asynchronous diff --git a/src/stdlib_system_subprocess.c b/src/stdlib_system_subprocess.c index 5d9386a22..667c0469e 100644 --- a/src/stdlib_system_subprocess.c +++ b/src/stdlib_system_subprocess.c @@ -28,7 +28,7 @@ typedef int64_t stdlib_pid; // 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_handle* handle, stdlib_pid* pid) { + stdlib_pid* pid) { STARTUPINFO si; PROCESS_INFORMATION pi; @@ -37,7 +37,6 @@ void process_create_windows(const char* cmd, const char* stdin_stream, FILE* stdin_fp = NULL; // Initialize null handle - (*handle) = NULL; (*pid) = 0; ZeroMemory(&si, sizeof(si)); @@ -112,7 +111,6 @@ void process_create_windows(const char* cmd, const char* stdin_stream, // Return the process handle for status queries CloseHandle(pi.hThread); // Close the thread handle - (*handle) = (stdlib_handle) pi.hProcess; // Return the process handle (*pid) = (stdlib_pid) pi.dwProcessId; } @@ -257,10 +255,9 @@ bool process_kill_unix(int pid) { // 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) +void process_create_posix(stdlib_pid* pid) { - (*handle) = NULL; (*pid) = (stdlib_pid) fork(); } @@ -273,11 +270,11 @@ void process_create_posix(stdlib_handle* handle, stdlib_pid* pid) // 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_handle* handle, stdlib_pid* pid) { + stdlib_pid* pid) { #ifdef _WIN32 - process_create_windows(cmd, stdin_stream, stdin_file, stdout_file, stderr_file, handle, pid); + process_create_windows(cmd, stdin_stream, stdin_file, stdout_file, stderr_file, pid); #else - process_create_posix(handle, pid); + process_create_posix(pid); #endif // _WIN32 } From d8df028ef54b00d08d7ec1cb70e9feafe4a2c6d5 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 25 Dec 2024 16:24:48 +0100 Subject: [PATCH 19/52] document `run` interface --- doc/specs/stdlib_system.md | 52 ++++++++++++++++++++++++++++++ src/stdlib_system.F90 | 55 ++++++++++++++++++++++++-------- src/stdlib_system_subprocess.F90 | 7 ++-- 3 files changed, 97 insertions(+), 17 deletions(-) create mode 100644 doc/specs/stdlib_system.md diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md new file mode 100644 index 000000000..f80ffbac2 --- /dev/null +++ b/doc/specs/stdlib_system.md @@ -0,0 +1,52 @@ +--- +title: system +--- + +# System + +[TOC] + +## `run` - Execute an external process + +### Status + +Experimental + +### Description + +The `run` interface allows execution of external processes using a single command string or a list of arguments. +Processes can be run either synchronously (blocking execution until the process finishes) or asynchronously (non-blocking execution). +Optional arguments enable the collection of standard output and error streams, as well as sending input via standard input. + +### Syntax + +`process = ` [[stdlib_subprocess(module):run(interface)]] `(args [, wait] [, stdin] [, want_stdout] [, want_stderr])` + +### 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. + +`wait` (optional): Shall be a `logical` flag. If `.true.` (default), the process will execute synchronously (blocking). If `.false.`, the process will execute asynchronously (non-blocking). 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. + +### 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(2) + +! Run a simple command line synchronously +p(1) = run("echo 'Hello, world!'", wait=.true., want_stdout=.true.) + +! Run a command using an argument list asynchronously +p(2) = run(["/usr/bin/ls", "-l"], wait=.false.) + diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 314fb9f5b..86a80a207 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -54,30 +54,57 @@ module stdlib_system end type process_type interface run - !> Open a new process from a command line - module type(process_type) function process_open_cmd(cmd,wait,stdin,want_stdout,want_stderr) result(process) - !> The command and arguments + !! version: experimental + !! + !! Executes an external process, either synchronously or asynchronously. + !! ([Specification](../page/specs/stdlib_system.html#run-execute-an-external-process)) + !! + !! ### Summary + !! Provides methods for executing external processes via a single command string or an argument list, + !! with options for synchronous or asynchronous execution and output collection. + !! + !! ### Description + !! + !! This interface allows the user to spawn external processes using either a single command string + !! or a list of arguments. Processes can be executed synchronously (blocking) or asynchronously + !! (non-blocking), with optional request to collect standard output and error streams, or to provide + !! a standard input stream via a `character` string. + !! + !! @note The implementation depends on system-level process management capabilities. + !! + !! #### Procedures + !! + !! - `process_open_cmd`: Opens a process using a command string. + !! - `process_open_args`: Opens a process using an array of arguments. + !! + module type(process_type) function process_open_cmd(cmd, wait, stdin, want_stdout, want_stderr) result(process) + !> The command line string to execute. character(*), intent(in) :: cmd - !> Optional character input to be sent to the process via pipe + !> Optional input sent to the process via standard input (stdin). character(*), optional, intent(in) :: stdin - !> Define if the process should be synchronous (wait=.true.), or asynchronous(wait=.false.) + !> Whether to wait for process completion (synchronous). logical, optional, intent(in) :: wait - !> Require collecting output - logical, optional, intent(in) :: want_stdout, want_stderr + !> Whether to collect standard output. + logical, optional, intent(in) :: want_stdout + !> Whether to collect standard error output. + logical, optional, intent(in) :: want_stderr end function process_open_cmd - !> Open a new, asynchronous process from a list of arguments - module type(process_type) function process_open_args(args,wait,stdin,want_stdout,want_stderr) result(process) - !> The command and arguments + + module type(process_type) function process_open_args(args, wait, stdin, want_stdout, want_stderr) result(process) + !> List of arguments for the process to execute. character(*), intent(in) :: args(:) - !> Optional character input to be sent to the process via pipe + !> Optional input sent to the process via standard input (stdin). character(*), optional, intent(in) :: stdin - !> Define if the process should be synchronous (wait=.true.), or asynchronous(wait=.false.) + !> Whether to wait for process completion (synchronous). logical, optional, intent(in) :: wait - !> Require collecting output - logical, optional, intent(in) :: want_stdout, want_stderr + !> Whether to collect standard output. + logical, optional, intent(in) :: want_stdout + !> Whether to collect standard error output. + logical, optional, intent(in) :: want_stderr end function process_open_args end interface run + !> Live check if a process is still running interface is_running module logical function process_is_running(process) result(is_running) diff --git a/src/stdlib_system_subprocess.F90 b/src/stdlib_system_subprocess.F90 index cfeb9b8f3..5d815ef77 100644 --- a/src/stdlib_system_subprocess.F90 +++ b/src/stdlib_system_subprocess.F90 @@ -6,9 +6,6 @@ use stdlib_linalg_state, only: linalg_state_type, LINALG_ERROR, linalg_error_handling implicit none(type, external) - logical(c_bool), parameter :: C_FALSE = .false._c_bool - logical(c_bool), parameter :: C_TRUE = .true._c_bool - ! Number of CPU ticks between status updates integer(TICKS), parameter :: CHECK_EVERY_TICKS = 100 @@ -70,6 +67,10 @@ end function process_has_win32 end interface + ! C boolean constants + logical(c_bool), parameter :: C_FALSE = .false._c_bool + logical(c_bool), parameter :: C_TRUE = .true._c_bool + contains ! Call system-dependent wait implementation From 94f2bdf1a89c23635c693c2f8fbb3a1b1e16f73b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 25 Dec 2024 16:37:50 +0100 Subject: [PATCH 20/52] document `is_running`, `is_completed`, `elapsed` --- doc/specs/stdlib_system.md | 137 +++++++++++++++++++++++++++++++++++++ src/stdlib_system.F90 | 63 +++++++++++++++-- 2 files changed, 194 insertions(+), 6 deletions(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index f80ffbac2..862946e1f 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -49,4 +49,141 @@ p(1) = run("echo 'Hello, world!'", wait=.true., want_stdout=.true.) ! Run a command using an argument list asynchronously p(2) = run(["/usr/bin/ls", "-l"], wait=.false.) +``` + +## `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 usage of is_running +type(process_type) :: proc +logical :: status + +! Start an asynchronous process +proc = run("sleep 10", wait=.false.) + +! Check if the process is running +status = is_running(proc) + +if (status) then + print *, "Process is still running." +else + print *, "Process has terminated." +end if +``` + +## `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 usage of is_completed +type(process_type) :: proc +logical :: status + +! Start an asynchronous process +proc = run("sleep 5", wait=.false.) + +! Check if the process has completed +status = is_completed(proc) + +if (status) then + print *, "Process has completed." +else + print *, "Process is still running." +end if +``` + +## `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(interface)]] `(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 usage of elapsed +type(process_type) :: p +real(RTICKS) :: delta_t + +! Create a process +p = run("sleep 5", wait=.false.) + +! Check elapsed time after 2 seconds +call sleep(2) +delta_t = elapsed(p) +print *, "Elapsed time (s): ", delta_t +``` + diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 86a80a207..b2d41399d 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -72,7 +72,7 @@ module stdlib_system !! !! @note The implementation depends on system-level process management capabilities. !! - !! #### Procedures + !! #### Methods !! !! - `process_open_cmd`: Opens a process using a command string. !! - `process_open_args`: Opens a process using an array of arguments. @@ -104,28 +104,79 @@ module type(process_type) function process_open_args(args, wait, stdin, want_std end function process_open_args end interface run - -!> Live check if a process is still running interface is_running + !! version: experimental + !! + !! Checks if an external process is still running. + !! ([Specification](../page/specs/stdlib_system.html#is_running-check-if-a-process-is-still-running)) + !! + !! ### Summary + !! Provides a method to determine if an external process is still actively running. + !! + !! ### Description + !! + !! This interface checks the status of an external process to determine whether it is still actively running. + !! It is particularly useful for monitoring asynchronous processes created using the `run` interface. + !! The internal state of the `process_type` object is updated after the call to reflect the current process status. + !! + !! @note The implementation relies on system-level process management capabilities. + !! module logical function process_is_running(process) result(is_running) + !> The process object to check. class(process_type), intent(inout) :: process + !> Logical result: `.true.` if the process is still running, `.false.` otherwise. end function process_is_running end interface is_running -!> Live check if a process is still running + interface is_completed + !! version: experimental + !! + !! Checks if an external process has completed execution. + !! ([Specification](../page/specs/stdlib_system.html#is_completed-check-if-a-process-has-completed-execution)) + !! + !! ### Summary + !! Provides a method to determine if an external process has finished execution. + !! + !! ### Description + !! + !! This interface checks the status of an external process to determine whether it has finished execution. + !! It is particularly useful for monitoring asynchronous processes created using the `run` interface. + !! The internal state of the `process_type` object is updated after the call to reflect the current process status. + !! + !! @note The implementation relies on system-level process management capabilities. + !! module logical function process_is_completed(process) result(is_completed) + !> The process object to check. class(process_type), intent(inout) :: process + !> Logical result: `.true.` if the process has completed, `.false.` otherwise. end function process_is_completed end interface is_completed -!> Return process lifetime so far, in seconds interface elapsed + !! version: experimental + !! + !! Returns the lifetime of a process, in seconds. + !! ([Specification](../page/specs/stdlib_system.html#elapsed-return-process-lifetime-in-seconds)) + !! + !! ### Summary + !! Provides the total elapsed time (in seconds) since the creation of the specified process. + !! + !! ### Description + !! + !! This interface returns the total elapsed time (in seconds) for a given process since it was started. + !! If the process is still running, the value returned reflects the time from the creation of the process + !! until the call to this function. Otherwise, the total process duration until completion is returned. + !! module real(RTICKS) function process_lifetime(process) result(delta_t) - class(process_type), intent(in) :: process + !> The process object for which to calculate elapsed time. + class(process_type), intent(in) :: process + !> The elapsed time in seconds since the process started. + real(RTICKS) :: delta_t end function process_lifetime end interface elapsed + !> Wait until a running process is completed interface wait module subroutine wait_for_completion(process, max_wait_time) From 3fb88e4c210e4868c8a31228fd1234cfdb5e7ad7 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 25 Dec 2024 16:44:28 +0100 Subject: [PATCH 21/52] add `system` page --- doc/specs/index.md | 1 + doc/specs/stdlib_system.md | 5 ++++- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/doc/specs/index.md b/doc/specs/index.md index de3eb8f38..6057fd848 100644 --- a/doc/specs/index.md +++ b/doc/specs/index.md @@ -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 diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index 862946e1f..637ff20c4 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -2,7 +2,10 @@ title: system --- -# 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] From 53fc8e59093b1f3a83a7c53bb5471a03b6ef6940 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 25 Dec 2024 16:49:58 +0100 Subject: [PATCH 22/52] document `wait` --- doc/specs/stdlib_system.md | 44 +++++++++++++++++++++++++++++++++++++- src/stdlib_system.F90 | 22 +++++++++++++++++-- 2 files changed, 63 insertions(+), 3 deletions(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index 637ff20c4..e05912b10 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -161,7 +161,7 @@ The result is a real value representing the elapsed time in seconds, measured fr ### Syntax -`delta_t = ` [[stdlib_subprocess(module):elapsed(interface)]] `(process)` +`delta_t = ` [[stdlib_subprocess(module):elapsed(subroutine)]] `(process)` ### Arguments @@ -189,4 +189,46 @@ delta_t = elapsed(p) print *, "Elapsed time (s): ", delta_t ``` +## `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 usage of wait +type(process_type) :: p + +! Start an asynchronous process +p = run("sleep 5", wait=.false.) + +! Wait for process to complete with a 10-second timeout +call wait(p, max_wait_time=10.0) +print *, "Process completed or timed out." +``` diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index b2d41399d..3785ea9f2 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -177,15 +177,33 @@ end function process_lifetime end interface elapsed -!> Wait until a running process is completed interface wait + !! version: experimental + !! + !! Waits for a running process to complete. + !! ([Specification](../page/specs/stdlib_system.html#wait-wait-until-a-running-process-is-completed)) + !! + !! ### Summary + !! Provides a method to block the execution and wait until the specified process finishes. + !! Supports an optional maximum wait time, after which the function returns regardless of process completion. + !! + !! ### Description + !! + !! This interface allows waiting for a process to complete. If the process is running asynchronously, this subroutine + !! will block further execution until the process finishes. Optionally, a maximum wait time can be specified; if + !! the process doesn't complete within this time, the subroutine returns without further waiting. + !! + !! @note The process state is accordingly updated on return from this call. + !! module subroutine wait_for_completion(process, max_wait_time) + !> The process object to monitor. class(process_type), intent(inout) :: process - ! Optional max wait time in seconds + !> Optional maximum wait time in seconds. If not provided, waits indefinitely. real, optional, intent(in) :: max_wait_time end subroutine wait_for_completion end interface wait + !> Query the system to update a process's state interface update module subroutine update_process_state(process) From b30cae4bfb75f57e12c8ad496a978bbfda2acbb9 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 25 Dec 2024 16:55:37 +0100 Subject: [PATCH 23/52] document `update` --- doc/specs/stdlib_system.md | 41 ++++++++++++++++++++++++++++++++++++++ src/stdlib_system.F90 | 22 ++++++++++++++++++-- 2 files changed, 61 insertions(+), 2 deletions(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index e05912b10..eaaaaf818 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -232,3 +232,44 @@ p = run("sleep 5", wait=.false.) call wait(p, max_wait_time=10.0) print *, "Process completed or timed out." ``` + +## `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 usage of update +type(process_type) :: p + +! Start an asynchronous process +p = run("sleep 5", wait=.false., want_stdout=.true., want_stderr=.true.) + +! Periodically update the process state +call update(p) + +! After completion, print the captured stdout and stderr +if (p%completed) then + print *, "Standard Output: ", p%stdout + print *, "Standard Error: ", p%stderr +endif +``` diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 3785ea9f2..26d74543c 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -203,14 +203,32 @@ module subroutine wait_for_completion(process, max_wait_time) end subroutine wait_for_completion end interface wait - -!> Query the system to update a process's state interface update + !! version: experimental + !! + !! Updates the internal state of a process variable. + !! ([Specification](../page/specs/stdlib_system.html#update-update-the-internal-state-of-a-process)) + !! + !! ### Summary + !! Provides a method to query the system and update the internal state of the specified process variable. + !! + !! ### Description + !! + !! This subroutine queries the system to retrieve and update information about the state of the process. + !! Once the process is completed, and if standard output or standard error were requested, their respective + !! data is loaded into the `process%stdout` and `process%stderr` variables. This routine is useful for keeping + !! track of the latest state and output of a process, particularly for asynchronous processes. + !! + !! @note This subroutine should be called periodically for asynchronous processes to check their completion + !! and retrieve the output. + !! module subroutine update_process_state(process) + !> The process object whose state needs to be updated. type(process_type), intent(inout) :: process end subroutine update_process_state end interface update + ! Kill a process interface kill module subroutine process_kill(process, success) From 122fbc6125deb8739568493efe126e9619f13d48 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 25 Dec 2024 16:59:35 +0100 Subject: [PATCH 24/52] document `kill` --- doc/specs/stdlib_system.md | 42 ++++++++++++++++++++++++++++++++++++++ src/stdlib_system.F90 | 27 ++++++++++++++++++++---- 2 files changed, 65 insertions(+), 4 deletions(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index eaaaaf818..d47215842 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -273,3 +273,45 @@ if (p%completed) then print *, "Standard Error: ", p%stderr endif ``` + +## `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 usage of kill +type(process_type) :: p +logical :: success + +! Start a process asynchronously +p = run("sleep 10", wait=.false.) + +! 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 +``` diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 26d74543c..46bc7bb7d 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -228,15 +228,34 @@ module subroutine update_process_state(process) end subroutine update_process_state end interface update - -! Kill a process interface kill + !! version: experimental + !! + !! Terminates a running process. + !! ([Specification](../page/specs/stdlib_system.html#kill-terminate-a-running-process)) + !! + !! ### Summary + !! Provides a method to kill or terminate a running process. + !! Returns a boolean flag indicating whether the termination was successful. + !! + !! ### Description + !! + !! This interface allows for the termination of an external process that is still running. + !! If the process is successfully killed, the `success` output flag is set to `.true.`, otherwise `.false.`. + !! This function is useful for controlling and managing processes that are no longer needed or for forcefully + !! stopping an unresponsive process. + !! + !! @note This operation may be system-dependent and could fail if the underlying user does not have + !! the necessary rights to kill a process. + !! module subroutine process_kill(process, success) + !> The process object to be terminated. type(process_type), intent(inout) :: process - ! Return a boolean flag for successful operation + !> Boolean flag indicating whether the termination was successful. logical, intent(out) :: success end subroutine process_kill -end interface kill +end interface kill + !! version: experimental !! From 56ed7c856133b63101bfa4e14a08de68b496670b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 25 Dec 2024 17:02:12 +0100 Subject: [PATCH 25/52] document `sleep` --- doc/specs/stdlib_system.md | 32 ++++++++++++++++++++++++++++++++ src/stdlib_system.F90 | 25 +++++++++++++++++++++---- 2 files changed, 53 insertions(+), 4 deletions(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index d47215842..806c2af80 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -315,3 +315,35 @@ else print *, "Failed to kill the process." end if ``` + +## `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 usage of sleep +print *, "Starting sleep..." + +! Sleep for 500 milliseconds +call sleep(500) + +print *, "Finished sleeping!" +``` diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 46bc7bb7d..90c09b733 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -256,14 +256,31 @@ module subroutine process_kill(process, success) end subroutine process_kill end interface kill - -!! version: experimental -!! interface sleep + !! version: experimental + !! + !! Pauses execution for a specified time in milliseconds. + !! ([Specification](../page/specs/stdlib_system.html#sleep-pause-execution-for-a-specified-time)) + !! + !! ### Summary + !! Pauses code execution for a specified number of milliseconds. This routine is a cross-platform + !! wrapper around platform-specific sleep functions, providing consistent behavior on different operating systems. + !! + !! ### Description + !! + !! This interface allows the user to pause the execution of a program for a specified duration, expressed in + !! milliseconds. It provides a cross-platform wrapper around native sleep functions, ensuring that the program + !! will sleep for the requested amount of time on different systems (e.g., using `Sleep` on Windows or `nanosleep` + !! on Unix-like systems). + !! + !! @note The precision of the sleep may vary depending on the system and platform. + !! module subroutine sleep(millisec) + !> The number of milliseconds to pause execution for. integer, intent(in) :: millisec end subroutine sleep -end interface sleep +end interface sleep + !! version: experimental !! From c6170481665d2d450feaa8af56fdde2eb89df922 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 25 Dec 2024 17:06:12 +0100 Subject: [PATCH 26/52] document `has_win32` --- doc/specs/stdlib_system.md | 28 ++++++++++++++++++++++++++++ src/stdlib_system.F90 | 28 +++++++++++++++++++++++----- 2 files changed, 51 insertions(+), 5 deletions(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index 806c2af80..def5e45b6 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -347,3 +347,31 @@ call sleep(500) print *, "Finished sleeping!" ``` + +## `has_win32` - Check if the system is running on Windows + +### Status + +Experimental + +### Description + +The `has_win32` 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):has_win32(function)]] `()` + +### Return Value + +Returns a `logical` flag: `.true.` if the system is Windows, or `.false.` otherwise. + +### Example + +```fortran +if (has_win32()) then + print *, "Running on Windows!" +else + print *, "Not running on Windows." +end if +``` diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 90c09b733..dfab7864a 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -260,7 +260,7 @@ end subroutine process_kill !! version: experimental !! !! Pauses execution for a specified time in milliseconds. - !! ([Specification](../page/specs/stdlib_system.html#sleep-pause-execution-for-a-specified-time)) + !! ([Specification](../page/specs/stdlib_system.html#sleep-pause-execution-for-a-specified-time=in-milliseconds)) !! !! ### Summary !! Pauses code execution for a specified number of milliseconds. This routine is a cross-platform @@ -281,12 +281,30 @@ module subroutine sleep(millisec) end subroutine sleep end interface sleep - -!! version: experimental -!! interface + + !! version: experimental + !! + !! Returns a `logical` flag indicating if the system is Windows. + !! ([Specification](../page/specs/stdlib_system.html#has_win32-check-if-the-system-is-running-on-windows)) + !! + !! ### Summary + !! A fast, compile-time check to determine if the system is running Windows, based on the `_WIN32` macro. + !! + !! ### Description + !! + !! This interface provides a function to check if the current system is Windows. The check is performed by + !! wrapping a C function that tests if the `_WIN32` macro is defined. This check is fast and occurs at + !! compile-time, making it a more efficient alternative to platform-specific runtime checks. + !! + !! The `has_win32` function is particularly useful for conditional compilation or system-specific code paths + !! that are dependent on whether the code is running on Windows. + !! + !! @note This function relies on the `_WIN32` macro, which is defined in C compilers when targeting Windows. + !! module logical function has_win32() end function has_win32 -end interface + +end interface end module stdlib_system From ed0565c24d2140b4d558cf62422d1048e2f127f9 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 25 Dec 2024 17:08:47 +0100 Subject: [PATCH 27/52] fix --- src/stdlib_system.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index dfab7864a..c4c3d78d0 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -168,7 +168,7 @@ end function process_is_completed !! If the process is still running, the value returned reflects the time from the creation of the process !! until the call to this function. Otherwise, the total process duration until completion is returned. !! - module real(RTICKS) function process_lifetime(process) result(delta_t) + module function process_lifetime(process) result(delta_t) !> The process object for which to calculate elapsed time. class(process_type), intent(in) :: process !> The elapsed time in seconds since the process started. From 74b6ebe1100bbecba77243dbe920b1c0bb99d57d Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 26 Dec 2024 10:34:15 +0100 Subject: [PATCH 28/52] change syntax for `ifx` fix --- src/stdlib_system.F90 | 8 ++++++-- src/stdlib_system_subprocess.F90 | 8 ++++++-- 2 files changed, 12 insertions(+), 4 deletions(-) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index c4c3d78d0..6f7d1b6e0 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -77,7 +77,7 @@ module stdlib_system !! - `process_open_cmd`: Opens a process using a command string. !! - `process_open_args`: Opens a process using an array of arguments. !! - module type(process_type) function process_open_cmd(cmd, wait, stdin, want_stdout, want_stderr) result(process) + module function process_open_cmd(cmd, wait, stdin, want_stdout, want_stderr) result(process) !> The command line string to execute. character(*), intent(in) :: cmd !> Optional input sent to the process via standard input (stdin). @@ -88,9 +88,11 @@ module type(process_type) function process_open_cmd(cmd, wait, stdin, want_stdou logical, optional, intent(in) :: want_stdout !> Whether to collect standard error output. logical, optional, intent(in) :: want_stderr + !> The output process handler. + type(process_type) :: process end function process_open_cmd - module type(process_type) function process_open_args(args, wait, stdin, want_stdout, want_stderr) result(process) + module function process_open_args(args, wait, stdin, want_stdout, want_stderr) result(process) !> List of arguments for the process to execute. character(*), intent(in) :: args(:) !> Optional input sent to the process via standard input (stdin). @@ -101,6 +103,8 @@ module type(process_type) function process_open_args(args, wait, stdin, want_std logical, optional, intent(in) :: want_stdout !> Whether to collect standard error output. logical, optional, intent(in) :: want_stderr + !> The output process handler. + type(process_type) :: process end function process_open_args end interface run diff --git a/src/stdlib_system_subprocess.F90 b/src/stdlib_system_subprocess.F90 index 5d815ef77..e57c073a2 100644 --- a/src/stdlib_system_subprocess.F90 +++ b/src/stdlib_system_subprocess.F90 @@ -82,7 +82,7 @@ module subroutine sleep(millisec) end subroutine sleep !> Open a new process - module type(process_type) function process_open_cmd(cmd,wait,stdin,want_stdout,want_stderr) result(process) + module function process_open_cmd(cmd,wait,stdin,want_stdout,want_stderr) result(process) !> The command and arguments character(*), intent(in) :: cmd !> Optional character input to be sent to the process via pipe @@ -91,13 +91,15 @@ module type(process_type) function process_open_cmd(cmd,wait,stdin,want_stdout,w logical, optional, intent(in) :: wait !> Require collecting output logical, optional, intent(in) :: want_stdout, want_stderr + !> The output process handler + type(process_type) :: process process = process_open_args([cmd],wait,stdin,want_stdout,want_stderr) end function process_open_cmd !> Open a new process - module type(process_type) function process_open_args(args,wait,stdin,want_stdout,want_stderr) result(process) + module function process_open_args(args,wait,stdin,want_stdout,want_stderr) result(process) !> The command and arguments character(*), intent(in) :: args(:) !> Optional character input to be sent to the process via pipe @@ -106,6 +108,8 @@ module type(process_type) function process_open_args(args,wait,stdin,want_stdout logical, optional, intent(in) :: wait !> Require collecting output logical, optional, intent(in) :: want_stdout, want_stderr + !> The output process handler + type(process_type) :: process real(RTICKS) :: count_rate logical :: asynchronous, collect_stdout, collect_stderr, has_stdin From 9873bc9898664a64d2d56002f17043b7c6dd36a3 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 26 Dec 2024 10:58:58 +0100 Subject: [PATCH 29/52] fix `sleep` us -> ns --- example/system/example_process_4.f90 | 5 ++++- src/stdlib_system_subprocess.c | 21 +++++++++++++-------- 2 files changed, 17 insertions(+), 9 deletions(-) diff --git a/example/system/example_process_4.f90 b/example/system/example_process_4.f90 index a1c5bad9e..de7c2e5c0 100644 --- a/example/system/example_process_4.f90 +++ b/example/system/example_process_4.f90 @@ -17,7 +17,7 @@ program example_process_kill print *, "Process running:", running ! Wait a bit before killing the process - call sleep(millisec=1250) ! Portable subroutine for sleeping + call sleep(millisec=250) print *, "Killing the process..." call kill(process, success) @@ -31,4 +31,7 @@ program example_process_kill ! Verify the process is no longer running running = is_running(process) print *, "Process running after kill:", running + + stop 0 + end program example_process_kill diff --git a/src/stdlib_system_subprocess.c b/src/stdlib_system_subprocess.c index 5e60c7994..5d1e8cff7 100644 --- a/src/stdlib_system_subprocess.c +++ b/src/stdlib_system_subprocess.c @@ -8,6 +8,7 @@ #ifdef _WIN32 #include #else +#define _POSIX_C_SOURCE 199309L #include #include #include @@ -317,15 +318,19 @@ void process_wait(float seconds) DWORD dwMilliseconds = 1000*seconds; Sleep(dwMilliseconds); #else - int uSeconds = (int) 1.0e6*seconds; + int ierr; - struct timespec t; - - t.tv_sec = seconds; - t.tv_nsec = seconds * 1000000; - - int ierr = nanosleep(&t, NULL); - + struct timespec ts_remaining; + ts_remaining.tv_sec = seconds; + ts_remaining.tv_nsec = seconds * 1000000000L; + + 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: From 34732ff73dc1863d4207909b6c8294c5adf17ec8 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 26 Dec 2024 11:08:17 +0100 Subject: [PATCH 30/52] fix `pid` size --- src/stdlib_system_subprocess.c | 23 ++++++++++++++--------- 1 file changed, 14 insertions(+), 9 deletions(-) diff --git a/src/stdlib_system_subprocess.c b/src/stdlib_system_subprocess.c index 5d1e8cff7..022f14112 100644 --- a/src/stdlib_system_subprocess.c +++ b/src/stdlib_system_subprocess.c @@ -129,14 +129,16 @@ void process_create_windows(const char* cmd, const char* stdin_stream, } // Query process state on a Windows system -void process_query_status_windows(int pid, bool wait, bool* is_running, int* exit_code) +void process_query_status_windows(stdlib_pid pid, bool wait, bool* is_running, int* exit_code) { int wait_code; HANDLE hProcess; - DWORD dwExitCode; + DWORD dwExitCode,dwPid; + + dwPid = (DWORD) pid; // Open the process with the appropriate access rights - hProcess = OpenProcess(PROCESS_QUERY_INFORMATION | SYNCHRONIZE, FALSE, pid); + hProcess = OpenProcess(PROCESS_QUERY_INFORMATION | SYNCHRONIZE, FALSE, dwPid); // Error opening the process, likely pid does not exist if (hProcess == NULL) { @@ -179,11 +181,14 @@ void process_query_status_windows(int pid, bool wait, bool* is_running, int* exi // 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) { +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, pid); + hProcess = OpenProcess(PROCESS_TERMINATE, FALSE, dwPid); if (hProcess == NULL) { // Failed to open the process; return false @@ -208,7 +213,7 @@ bool process_kill_windows(int pid) { ///////////////////////////////////////////////////////////////////////////////////// // Unix-specific code ///////////////////////////////////////////////////////////////////////////////////// -void process_query_status_unix(int pid, bool wait, bool* is_running, int* exit_code) +void process_query_status_unix(stdlib_pid pid, bool wait, bool* is_running, int* exit_code) { int status; int wait_code; @@ -249,7 +254,7 @@ 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) { +bool process_kill_unix(stdlib_pid pid) { // Send the SIGKILL signal to the process if (kill(pid, SIGKILL) == 0) { // Successfully sent the signal @@ -292,7 +297,7 @@ void process_create(const char* cmd, const char* stdin_stream, const char* stdin } // Cross-platform interface: query process state -void process_query_status(int pid, bool wait, bool* is_running, int* exit_code) +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); @@ -302,7 +307,7 @@ void process_query_status(int pid, bool wait, bool* is_running, int* exit_code) } // Cross-platform interface: kill process by ID -bool process_kill(int pid) +bool process_kill(stdlib_pid pid) { #ifdef _WIN32 return process_kill_windows(pid); From 53b03b05c526a07f395b3d500bd780cf39cf6e76 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 26 Dec 2024 11:12:13 +0100 Subject: [PATCH 31/52] full-cmd: do not use stack --- src/stdlib_system_subprocess.c | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/src/stdlib_system_subprocess.c b/src/stdlib_system_subprocess.c index 022f14112..142667306 100644 --- a/src/stdlib_system_subprocess.c +++ b/src/stdlib_system_subprocess.c @@ -92,13 +92,26 @@ void process_create_windows(const char* cmd, const char* stdin_stream, si.dwFlags |= STARTF_USESTDHANDLES; // Prepare the command line with redirected stdin - char full_cmd[4096]; + 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, sizeof(full_cmd), "%s < %s", cmd, stdin_file); + snprintf(full_cmd, full_cmd_len, "%s < %s", cmd, stdin_file); } else { - snprintf(full_cmd, sizeof(full_cmd), "%s", cmd); + snprintf(full_cmd, full_cmd_len, "%s", cmd); } + // Free the allocated memory + free(full_cmd); + // Create the process BOOL success = CreateProcess( NULL, // Application name From 5a1bd5405d9803cf22eded8c225db5425dcf41b1 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 26 Dec 2024 11:38:49 +0100 Subject: [PATCH 32/52] fix `sleep` --- example/system/example_process_2.f90 | 4 ++-- example/system/example_process_4.f90 | 2 +- src/stdlib_system_subprocess.F90 | 2 +- src/stdlib_system_subprocess.c | 23 +++++++++++++---------- 4 files changed, 17 insertions(+), 14 deletions(-) diff --git a/example/system/example_process_2.f90 b/example/system/example_process_2.f90 index 37ce3efd2..fc7f57948 100644 --- a/example/system/example_process_2.f90 +++ b/example/system/example_process_2.f90 @@ -5,8 +5,8 @@ program run_async type(process_type) :: p - ! Run an asynchronous process to sleep for 5 seconds - p = run("sleep 3", wait=.false.) + ! Run an asynchronous process to sleep for 1 second + p = run("sleep 1", wait=.false.) ! Check if the process is running if (is_running(p)) then diff --git a/example/system/example_process_4.f90 b/example/system/example_process_4.f90 index de7c2e5c0..bacfde5cf 100644 --- a/example/system/example_process_4.f90 +++ b/example/system/example_process_4.f90 @@ -30,7 +30,7 @@ program example_process_kill ! Verify the process is no longer running running = is_running(process) - print *, "Process running after kill:", running + print *, "Process running after kill:", running,' runtime=',elapsed(process) stop 0 diff --git a/src/stdlib_system_subprocess.F90 b/src/stdlib_system_subprocess.F90 index e57c073a2..e222e943c 100644 --- a/src/stdlib_system_subprocess.F90 +++ b/src/stdlib_system_subprocess.F90 @@ -77,7 +77,7 @@ end function process_has_win32 module subroutine sleep(millisec) integer, intent(in) :: millisec - call process_wait(real(0.001*millisec,c_float)) + call process_wait(real(0.001*real(max(0,millisec),c_float),c_float)) end subroutine sleep diff --git a/src/stdlib_system_subprocess.c b/src/stdlib_system_subprocess.c index 142667306..683c79e2f 100644 --- a/src/stdlib_system_subprocess.c +++ b/src/stdlib_system_subprocess.c @@ -109,9 +109,6 @@ void process_create_windows(const char* cmd, const char* stdin_stream, snprintf(full_cmd, full_cmd_len, "%s", cmd); } - // Free the allocated memory - free(full_cmd); - // Create the process BOOL success = CreateProcess( NULL, // Application name @@ -126,8 +123,11 @@ void process_create_windows(const char* cmd, const char* stdin_stream, &pi // PROCESS_INFORMATION ); + // Free the allocated memory + free(full_cmd); + if (!success) { - fprintf(stderr, "CreateProcess failed (%lud).\n", GetLastError()); + fprintf(stderr, "CreateProcess failed (%lu).\n", GetLastError()); return; } @@ -333,15 +333,18 @@ bool process_kill(stdlib_pid pid) void process_wait(float seconds) { #ifdef _WIN32 - DWORD dwMilliseconds = 1000*seconds; + DWORD dwMilliseconds = (DWORD) (seconds * 1000); Sleep(dwMilliseconds); #else int ierr; - struct timespec ts_remaining; - ts_remaining.tv_sec = seconds; - ts_remaining.tv_nsec = seconds * 1000000000L; - + unsigned int ms = (unsigned int) (seconds * 1000); + struct timespec ts_remaining = + { + ms / 1000, + (ms % 1000) * 1000000L + }; + do { struct timespec ts_sleep = ts_remaining; @@ -358,7 +361,7 @@ void process_wait(float seconds) fprintf(stderr, "nanosleep() bad milliseconds value\n"); exit(EINVAL); case EFAULT: - fprintf(stderr, "nanosleep() bad milliseconds value\n"); + fprintf(stderr, "nanosleep() problem copying information to user space\n"); exit(EFAULT); case ENOSYS: fprintf(stderr, "nanosleep() not supported on this system\n"); From 9b74beae7f5e5347861ebfde93db605056febe5f Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 26 Dec 2024 12:31:49 +0100 Subject: [PATCH 33/52] process example 2: set max_wait_time --- example/system/example_process_2.f90 | 2 +- example/system/example_process_4.f90 | 4 +--- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/example/system/example_process_2.f90 b/example/system/example_process_2.f90 index fc7f57948..249fd0794 100644 --- a/example/system/example_process_2.f90 +++ b/example/system/example_process_2.f90 @@ -16,6 +16,6 @@ program run_async end if ! Wait for the process to complete - call wait(p) + call wait(p, max_wait_time = 5.0) print *, "Process has now completed." end program run_async diff --git a/example/system/example_process_4.f90 b/example/system/example_process_4.f90 index bacfde5cf..b2850cd8a 100644 --- a/example/system/example_process_4.f90 +++ b/example/system/example_process_4.f90 @@ -30,8 +30,6 @@ program example_process_kill ! Verify the process is no longer running running = is_running(process) - print *, "Process running after kill:", running,' runtime=',elapsed(process) - - stop 0 + print *, "Process running after kill:", running end program example_process_kill From bdb2840ad3e741c8a831e02b4272e54caf12131b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 26 Dec 2024 19:08:49 +0100 Subject: [PATCH 34/52] sleep: fix `bind(C)` interface --- src/stdlib_system_subprocess.F90 | 24 +++++++++++++++++++----- 1 file changed, 19 insertions(+), 5 deletions(-) diff --git a/src/stdlib_system_subprocess.F90 b/src/stdlib_system_subprocess.F90 index e222e943c..aaeea1596 100644 --- a/src/stdlib_system_subprocess.F90 +++ b/src/stdlib_system_subprocess.F90 @@ -49,7 +49,7 @@ end function process_system_kill subroutine process_wait(seconds) bind(C,name='process_wait') import c_float implicit none - real(c_float), intent(in) :: seconds + real(c_float), intent(in), value :: seconds end subroutine process_wait ! Return path to the null device @@ -76,8 +76,12 @@ end function process_has_win32 ! Call system-dependent wait implementation module subroutine sleep(millisec) integer, intent(in) :: millisec + + real(c_float) :: seconds + + seconds = 0.001_c_float*max(0,millisec) - call process_wait(real(0.001*real(max(0,millisec),c_float),c_float)) + call process_wait(seconds) end subroutine sleep @@ -262,8 +266,16 @@ module subroutine wait_for_completion(process, max_wait_time) ! Optional max wait time in seconds real, optional, intent(in) :: max_wait_time + integer :: sleep_interval real(RTICKS) :: wait_time, elapsed integer(TICKS) :: start_time, current_time, count_rate + + ! Sleep interval ms + integer, parameter :: MIN_WAIT_MS = 1 + integer, parameter :: MAX_WAIT_MS = 100 + + ! Starting sleep interval: 1ms + sleep_interval = MIN_WAIT_MS ! Determine the wait time if (present(max_wait_time)) then @@ -279,9 +291,11 @@ module subroutine wait_for_completion(process, max_wait_time) ! Wait loop wait_loop: do while (process_is_running(process) .and. elapsed <= wait_time) - - ! Small sleep to avoid CPU hogging (1 ms) - call sleep(1) + + ! Small sleep to avoid CPU hogging, with exponential backoff (1 ms) + ! from 1ms up to 100ms + call sleep(millisec=sleep_interval) + sleep_interval = min(sleep_interval*2, MAX_WAIT_MS) call system_clock(current_time) elapsed = real(current_time - start_time, RTICKS) / count_rate From a1aaf2fe6dce4bb8b2ba7a7c750f3ffb4b642fff Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 28 Jan 2025 19:54:46 +0100 Subject: [PATCH 35/52] split `run` vs `runasync` --- example/system/example_process_1.f90 | 2 +- example/system/example_process_2.f90 | 4 +- example/system/example_process_3.f90 | 4 +- example/system/example_process_4.f90 | 6 +- src/stdlib_system.F90 | 62 +++++++++++++++++---- src/stdlib_system_subprocess.F90 | 83 ++++++++++++++++++++++++---- test/system/test_subprocess.f90 | 14 ++--- 7 files changed, 138 insertions(+), 37 deletions(-) diff --git a/example/system/example_process_1.f90 b/example/system/example_process_1.f90 index b1dbe113d..b69b9c999 100644 --- a/example/system/example_process_1.f90 +++ b/example/system/example_process_1.f90 @@ -7,7 +7,7 @@ program run_sync logical :: completed ! Run a synchronous process to list directory contents - p = run("ls -l", wait=.true., want_stdout=.true.) + p = run("ls -l", want_stdout=.true.) ! Check if the process is completed (should be true since wait=.true.) if (is_completed(p)) then diff --git a/example/system/example_process_2.f90 b/example/system/example_process_2.f90 index 249fd0794..df6c91f3d 100644 --- a/example/system/example_process_2.f90 +++ b/example/system/example_process_2.f90 @@ -1,12 +1,12 @@ ! Process example 2: Run an Asynchronous Command and check its status program run_async - use stdlib_system, only: process_type, run, is_running, wait + 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 = run("sleep 1", wait=.false.) + p = runasync("sleep 1") ! Check if the process is running if (is_running(p)) then diff --git a/example/system/example_process_3.f90 b/example/system/example_process_3.f90 index 9be919d3f..c5bc29056 100644 --- a/example/system/example_process_3.f90 +++ b/example/system/example_process_3.f90 @@ -11,8 +11,8 @@ program run_with_args args(1) = "echo" args(2) = "Hello, Fortran!" - ! Run the command with arguments - p = run(args, wait=.true.) + ! Run the command with arguments (synchronous) + p = run(args) ! Print the runtime of the process print *, "Process runtime:", elapsed(p), "seconds." diff --git a/example/system/example_process_4.f90 b/example/system/example_process_4.f90 index b2850cd8a..f72d9f953 100644 --- a/example/system/example_process_4.f90 +++ b/example/system/example_process_4.f90 @@ -1,15 +1,15 @@ ! Process example 4: Kill a running process program example_process_kill - use stdlib_system, only: process_type, run, is_running, kill, elapsed, has_win32, sleep + use stdlib_system, only: process_type, runasync, is_running, kill, elapsed, has_win32, sleep implicit none type(process_type) :: process logical :: running, success print *, "Starting a long-running process..." if (has_win32()) then - process = run("ping -n 10 127.0.0.1", wait=.false.) + process = runasync("ping -n 10 127.0.0.1") else - process = run("ping -c 10 127.0.0.1", wait=.false.) + process = runasync("ping -c 10 127.0.0.1") endif ! Verify the process is running diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 6f7d1b6e0..53ab36fae 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -7,6 +7,7 @@ module stdlib_system !> Public sub-processing interface public :: run +public :: runasync public :: process_type public :: is_completed public :: is_running @@ -53,7 +54,7 @@ module stdlib_system end type process_type -interface run +interface runasync !! version: experimental !! !! Executes an external process, either synchronously or asynchronously. @@ -72,40 +73,77 @@ module stdlib_system !! !! @note The implementation depends on system-level process management capabilities. !! - !! #### Methods + module function run_async_cmd(cmd, stdin, want_stdout, want_stderr) result(process) + !> The command line string to execute. + character(*), intent(in) :: cmd + !> Optional input sent to the process via standard input (stdin). + character(*), optional, intent(in) :: stdin + !> Whether to collect standard output. + logical, optional, intent(in) :: want_stdout + !> Whether to collect standard error output. + logical, optional, intent(in) :: want_stderr + !> The output process handler. + type(process_type) :: process + end function run_async_cmd + + module function run_async_args(args, stdin, want_stdout, want_stderr) result(process) + !> List of arguments for the process to execute. + character(*), intent(in) :: args(:) + !> Optional input sent to the process via standard input (stdin). + character(*), optional, intent(in) :: stdin + !> Whether to collect standard output. + logical, optional, intent(in) :: want_stdout + !> Whether to collect standard error output. + logical, optional, intent(in) :: want_stderr + !> The output process handler. + type(process_type) :: process + end function run_async_args +end interface runasync + +interface run + !! version: experimental + !! + !! Executes an external process, either synchronously or asynchronously. + !! ([Specification](../page/specs/stdlib_system.html#run-execute-an-external-process)) + !! + !! ### Summary + !! Provides methods for executing external processes via a single command string or an argument list, + !! with options for synchronous or asynchronous execution and output collection. !! - !! - `process_open_cmd`: Opens a process using a command string. - !! - `process_open_args`: Opens a process using an array of arguments. + !! ### Description !! - module function process_open_cmd(cmd, wait, stdin, want_stdout, want_stderr) result(process) + !! This interface allows the user to spawn external processes using either a single command string + !! or a list of arguments. Processes can be executed synchronously (blocking) or asynchronously + !! (non-blocking), with optional request to collect standard output and error streams, or to provide + !! a standard input stream via a `character` string. + !! + !! @note The implementation depends on system-level process management capabilities. + !! + module function run_sync_cmd(cmd, stdin, want_stdout, want_stderr) result(process) !> The command line string to execute. character(*), intent(in) :: cmd !> Optional input sent to the process via standard input (stdin). character(*), optional, intent(in) :: stdin - !> Whether to wait for process completion (synchronous). - logical, optional, intent(in) :: wait !> Whether to collect standard output. logical, optional, intent(in) :: want_stdout !> Whether to collect standard error output. logical, optional, intent(in) :: want_stderr !> The output process handler. type(process_type) :: process - end function process_open_cmd + end function run_sync_cmd - module function process_open_args(args, wait, stdin, want_stdout, want_stderr) result(process) + module function run_sync_args(args, stdin, want_stdout, want_stderr) result(process) !> List of arguments for the process to execute. character(*), intent(in) :: args(:) !> Optional input sent to the process via standard input (stdin). character(*), optional, intent(in) :: stdin - !> Whether to wait for process completion (synchronous). - logical, optional, intent(in) :: wait !> Whether to collect standard output. logical, optional, intent(in) :: want_stdout !> Whether to collect standard error output. logical, optional, intent(in) :: want_stderr !> The output process handler. type(process_type) :: process - end function process_open_args + end function run_sync_args end interface run interface is_running diff --git a/src/stdlib_system_subprocess.F90 b/src/stdlib_system_subprocess.F90 index aaeea1596..d9aea78f4 100644 --- a/src/stdlib_system_subprocess.F90 +++ b/src/stdlib_system_subprocess.F90 @@ -85,31 +85,95 @@ module subroutine sleep(millisec) end subroutine sleep - !> Open a new process - module function process_open_cmd(cmd,wait,stdin,want_stdout,want_stderr) result(process) + module function run_async_cmd(cmd, stdin, want_stdout, want_stderr) result(process) + !> The command line string to execute. + character(*), intent(in) :: cmd + !> Optional input sent to the process via standard input (stdin). + character(*), optional, intent(in) :: stdin + !> Whether to collect standard output. + logical, optional, intent(in) :: want_stdout + !> Whether to collect standard error output. + logical, optional, intent(in) :: want_stderr + !> The output process handler. + type(process_type) :: process + + process = process_open([cmd],.false.,stdin,want_stdout,want_stderr) + + end function run_async_cmd + + module function run_async_args(args, stdin, want_stdout, want_stderr) result(process) + !> List of arguments for the process to execute. + character(*), intent(in) :: args(:) + !> Optional input sent to the process via standard input (stdin). + character(*), optional, intent(in) :: stdin + !> Whether to collect standard output. + logical, optional, intent(in) :: want_stdout + !> Whether to collect standard error output. + logical, optional, intent(in) :: want_stderr + !> The output process handler. + type(process_type) :: process + + process = process_open(args,.false.,stdin,want_stdout,want_stderr) + + end function run_async_args + + module function run_sync_cmd(cmd, stdin, want_stdout, want_stderr) result(process) + !> The command line string to execute. + character(*), intent(in) :: cmd + !> Optional input sent to the process via standard input (stdin). + character(*), optional, intent(in) :: stdin + !> Whether to collect standard output. + logical, optional, intent(in) :: want_stdout + !> Whether to collect standard error output. + logical, optional, intent(in) :: want_stderr + !> The output process handler. + type(process_type) :: process + + process = process_open([cmd],.true.,stdin,want_stdout,want_stderr) + + end function run_sync_cmd + + module function run_sync_args(args, stdin, want_stdout, want_stderr) result(process) + !> List of arguments for the process to execute. + character(*), intent(in) :: args(:) + !> Optional input sent to the process via standard input (stdin). + character(*), optional, intent(in) :: stdin + !> Whether to collect standard output. + logical, optional, intent(in) :: want_stdout + !> Whether to collect standard error output. + logical, optional, intent(in) :: want_stderr + !> The output process handler. + type(process_type) :: process + + process = process_open(args,.true.,stdin,want_stdout,want_stderr) + + end function run_sync_args + + !> Internal function: open a new process from a command line + function process_open_cmd(cmd,wait,stdin,want_stdout,want_stderr) result(process) !> The command and arguments character(*), intent(in) :: cmd !> Optional character input to be sent to the process via pipe character(*), optional, intent(in) :: stdin !> Define if the process should be synchronous (wait=.true.), or asynchronous(wait=.false.) - logical, optional, intent(in) :: wait + logical, intent(in) :: wait !> Require collecting output logical, optional, intent(in) :: want_stdout, want_stderr !> The output process handler type(process_type) :: process - process = process_open_args([cmd],wait,stdin,want_stdout,want_stderr) + process = process_open([cmd],wait,stdin,want_stdout,want_stderr) end function process_open_cmd - !> Open a new process - module function process_open_args(args,wait,stdin,want_stdout,want_stderr) result(process) + !> Internal function: open a new process from arguments + function process_open(args,wait,stdin,want_stdout,want_stderr) result(process) !> The command and arguments character(*), intent(in) :: args(:) !> Optional character input to be sent to the process via pipe character(*), optional, intent(in) :: stdin !> Define if the process should be synchronous (wait=.true.), or asynchronous(wait=.false.) - logical, optional, intent(in) :: wait + logical, intent(in) :: wait !> Require collecting output logical, optional, intent(in) :: want_stdout, want_stderr !> The output process handler @@ -121,11 +185,10 @@ module function process_open_args(args,wait,stdin,want_stdout,want_stderr) resul integer(TICKS) :: count_max ! Process user requests - asynchronous = .false. + asynchronous = .not.wait collect_stdout = .false. collect_stderr = .false. has_stdin = present(stdin) - if (present(wait)) asynchronous = .not.wait if (present(want_stdout)) collect_stdout = want_stdout if (present(want_stderr)) collect_stderr = want_stderr @@ -173,7 +236,7 @@ module function process_open_args(args,wait,stdin,want_stdout,want_stderr) resul ! Run a first update call update_process_state(process) - end function process_open_args + end function process_open subroutine launch_asynchronous(process, args, stdin) class(process_type), intent(inout) :: process diff --git a/test/system/test_subprocess.f90 b/test/system/test_subprocess.f90 index 1da80adaf..02a873b48 100644 --- a/test/system/test_subprocess.f90 +++ b/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, kill + use stdlib_system, only: process_type, run, runasync, is_running, wait, update, elapsed, has_win32, kill implicit none @@ -25,7 +25,7 @@ subroutine test_run_synchronous(error) type(process_type) :: process character(len=*), parameter :: command = "echo Hello" - process = run(command, wait=.true., want_stdout=.true.) + process = run(command, want_stdout=.true.) call check(error, process%completed) if (allocated(error)) return @@ -40,9 +40,9 @@ subroutine test_run_asynchronous(error) ! The closest possible to a cross-platform command that waits if (has_win32()) then - process = run("ping -n 2 127.0.0.1", wait=.false.) + process = runasync("ping -n 2 127.0.0.1") else - process = run("ping -c 2 127.0.0.1", wait=.false.) + 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") @@ -68,9 +68,9 @@ subroutine test_process_kill(error) ! Start a long-running process asynchronously if (has_win32()) then - process = run("ping -n 10 127.0.0.1", wait=.false.) + process = runasync("ping -n 10 127.0.0.1") else - process = run("ping -c 10 127.0.0.1", wait=.false.) + process = runasync("ping -c 10 127.0.0.1") endif ! Ensure the process starts running @@ -100,7 +100,7 @@ subroutine test_process_state(error) type(process_type) :: process character(len=*), parameter :: command = "echo Testing" - process = run(command, wait=.true., want_stdout=.true., want_stderr=.true.) + process = run(command, want_stdout=.true., want_stderr=.true.) call update(process) call check(error, process%completed) From 4d5eb321bb9216be11ec3aca74f0035f7fd19528 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 28 Jan 2025 20:00:46 +0100 Subject: [PATCH 36/52] `run/runasync` docs --- doc/specs/stdlib_system.md | 53 +++++++++++++++++++++++++++++++++----- src/stdlib_system.F90 | 30 ++++++++++----------- 2 files changed, 60 insertions(+), 23 deletions(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index def5e45b6..afdccddd8 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -9,7 +9,7 @@ and monitoring of system commands or applications directly from Fortran. [TOC] -## `run` - Execute an external process +## `run` - Execute an external process synchronously ### Status @@ -18,18 +18,57 @@ Experimental ### Description The `run` interface allows execution of external processes using a single command string or a list of arguments. -Processes can be run either synchronously (blocking execution until the process finishes) or asynchronously (non-blocking execution). +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. ### Syntax -`process = ` [[stdlib_subprocess(module):run(interface)]] `(args [, wait] [, stdin] [, want_stdout] [, want_stderr])` +`process = ` [[stdlib_subprocess(module):run(interface)]] `(args [, stdin] [, want_stdout] [, want_stderr])` ### 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. -`wait` (optional): Shall be a `logical` flag. If `.true.` (default), the process will execute synchronously (blocking). If `.false.`, the process will execute asynchronously (non-blocking). 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. + +### 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. + +### Syntax + +`process = ` [[stdlib_subprocess(module):runasync(interface)]] `(args [, stdin] [, want_stdout] [, want_stderr])` + +### 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. @@ -47,11 +86,11 @@ Returns an object of type `process_type` that contains information about the sta ! Example usage with command line or list of arguments type(process_type) :: p(2) -! Run a simple command line synchronously -p(1) = run("echo 'Hello, world!'", wait=.true., want_stdout=.true.) +! Run a simple command line asynchronously +p(1) = runasync("echo 'Hello, world!'", want_stdout=.true.) ! Run a command using an argument list asynchronously -p(2) = run(["/usr/bin/ls", "-l"], wait=.false.) +p(2) = runasync(["/usr/bin/ls", "-l"], want_stdout=.true.) ``` ## `is_running` - Check if a process is still running diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 53ab36fae..6d3b1570e 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -57,19 +57,18 @@ module stdlib_system interface runasync !! version: experimental !! - !! Executes an external process, either synchronously or asynchronously. - !! ([Specification](../page/specs/stdlib_system.html#run-execute-an-external-process)) + !! Executes an external process asynchronously. + !! ([Specification](../page/specs/stdlib_system.html#run-execute-an-external-process-asynchronously)) !! !! ### Summary - !! Provides methods for executing external processes via a single command string or an argument list, - !! with options for synchronous or asynchronous execution and output collection. + !! Provides methods for executing external processes asynchronously, using either a single command string + !! or an argument list, with options for output collection and standard input. !! !! ### Description !! - !! This interface allows the user to spawn external processes using either a single command string - !! or a list of arguments. Processes can be executed synchronously (blocking) or asynchronously - !! (non-blocking), with optional request to collect standard output and error streams, or to provide - !! a standard input stream via a `character` string. + !! This interface allows the user to spawn external processes asynchronously (non-blocking). + !! Processes can be executed via a single command string or a list of arguments, with options to collect + !! standard output and error streams, or to provide a standard input stream via a `character` string. !! !! @note The implementation depends on system-level process management capabilities. !! @@ -103,19 +102,18 @@ end function run_async_args interface run !! version: experimental !! - !! Executes an external process, either synchronously or asynchronously. - !! ([Specification](../page/specs/stdlib_system.html#run-execute-an-external-process)) + !! Executes an external process synchronously. + !! ([Specification](../page/specs/stdlib_system.html#runasync-execute-an-external-process-synchronously)) !! !! ### Summary - !! Provides methods for executing external processes via a single command string or an argument list, - !! with options for synchronous or asynchronous execution and output collection. + !! Provides methods for executing external processes synchronously, using either a single command string + !! or an argument list, with options for output collection and standard input. !! !! ### Description !! - !! This interface allows the user to spawn external processes using either a single command string - !! or a list of arguments. Processes can be executed synchronously (blocking) or asynchronously - !! (non-blocking), with optional request to collect standard output and error streams, or to provide - !! a standard input stream via a `character` string. + !! This interface allows the user to spawn external processes synchronously (blocking), + !! via either a single command string or a list of arguments. It also includes options to collect + !! standard output and error streams, or to provide a standard input stream via a `character` string. !! !! @note The implementation depends on system-level process management capabilities. !! From 56f02ab1e021b193de3fd32cfa55cbec1a84f1bb Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 28 Jan 2025 20:06:43 +0100 Subject: [PATCH 37/52] `has_win32` -> `is_windows` --- doc/specs/stdlib_system.md | 10 ++++++---- src/stdlib_system.F90 | 10 +++++----- src/stdlib_system_subprocess.F90 | 10 +++++----- src/stdlib_system_subprocess.c | 2 +- 4 files changed, 17 insertions(+), 15 deletions(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index afdccddd8..ae267fedb 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -387,7 +387,7 @@ call sleep(500) print *, "Finished sleeping!" ``` -## `has_win32` - Check if the system is running on Windows +## `is_windows` - Check if the system is running on Windows ### Status @@ -395,11 +395,13 @@ Experimental ### Description -The `has_win32` 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. +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):has_win32(function)]] `()` +`result = ` [[stdlib_system(module):is_windows(function)]] `()` ### Return Value @@ -408,7 +410,7 @@ Returns a `logical` flag: `.true.` if the system is Windows, or `.false.` otherw ### Example ```fortran -if (has_win32()) then +if (is_windows()) then print *, "Running on Windows!" else print *, "Not running on Windows." diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 6d3b1570e..089033279 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -15,7 +15,7 @@ module stdlib_system public :: wait public :: kill public :: elapsed -public :: has_win32 +public :: is_windows ! CPU clock ticks storage integer, parameter, private :: TICKS = int64 @@ -326,7 +326,7 @@ end subroutine sleep !! version: experimental !! !! Returns a `logical` flag indicating if the system is Windows. - !! ([Specification](../page/specs/stdlib_system.html#has_win32-check-if-the-system-is-running-on-windows)) + !! ([Specification](../page/specs/stdlib_system.html#is_windows-check-if-the-system-is-running-on-windows)) !! !! ### Summary !! A fast, compile-time check to determine if the system is running Windows, based on the `_WIN32` macro. @@ -337,13 +337,13 @@ end subroutine sleep !! wrapping a C function that tests if the `_WIN32` macro is defined. This check is fast and occurs at !! compile-time, making it a more efficient alternative to platform-specific runtime checks. !! - !! The `has_win32` function is particularly useful for conditional compilation or system-specific code paths + !! The `is_windows` function is particularly useful for conditional compilation or system-specific code paths !! that are dependent on whether the code is running on Windows. !! !! @note This function relies on the `_WIN32` macro, which is defined in C compilers when targeting Windows. !! - module logical function has_win32() - end function has_win32 + module logical function is_windows() + end function is_windows end interface diff --git a/src/stdlib_system_subprocess.F90 b/src/stdlib_system_subprocess.F90 index d9aea78f4..b659513d1 100644 --- a/src/stdlib_system_subprocess.F90 +++ b/src/stdlib_system_subprocess.F90 @@ -60,10 +60,10 @@ type(c_ptr) function process_null_device(len) bind(C,name='process_null_device') end function process_null_device ! Utility: check if _WIN32 is defined in the C compiler - logical(c_bool) function process_has_win32() bind(C,name='process_has_win32') + logical(c_bool) function process_is_windows() bind(C,name='process_is_windows') import c_bool implicit none - end function process_has_win32 + end function process_is_windows end interface @@ -584,9 +584,9 @@ end function null_device !> Returns the file path of the null device for the current operating system. !> !> Version: Helper function. - module logical function has_win32() - has_win32 = logical(process_has_win32()) - end function has_win32 + module logical function is_windows() + is_windows = logical(process_is_windows()) + end function is_windows !> Reads a whole ASCII file and loads its contents into an allocatable character string.. !> The function handles error states and optionally deletes the file after reading. diff --git a/src/stdlib_system_subprocess.c b/src/stdlib_system_subprocess.c index 683c79e2f..59f010ddd 100644 --- a/src/stdlib_system_subprocess.c +++ b/src/stdlib_system_subprocess.c @@ -388,7 +388,7 @@ const char* process_null_device(int* len) } // Returns a boolean flag if macro _WIN32 is defined -bool process_has_win32() +bool process_is_windows() { #ifdef _WIN32 return true; From 15689bc2f7a361260f5f2e07b20bc212413b4e39 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 28 Jan 2025 20:08:27 +0100 Subject: [PATCH 38/52] Update example_process_1.f90 --- example/system/example_process_1.f90 | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/example/system/example_process_1.f90 b/example/system/example_process_1.f90 index b69b9c999..d0b416ba2 100644 --- a/example/system/example_process_1.f90 +++ b/example/system/example_process_1.f90 @@ -1,13 +1,17 @@ ! Process example 1: Run a Command Synchronously and Capture Output program run_sync - use stdlib_system, only: run, is_completed, process_type + 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 - p = run("ls -l", want_stdout=.true.) + 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 From 3560a6fe6692a4115f86b604212a58c167af05cd Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 28 Jan 2025 20:13:00 +0100 Subject: [PATCH 39/52] missing `is_windows` tests --- test/system/test_subprocess.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/test/system/test_subprocess.f90 b/test/system/test_subprocess.f90 index 02a873b48..248e9bb8e 100644 --- a/test/system/test_subprocess.f90 +++ b/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, runasync, is_running, wait, update, elapsed, has_win32, kill + use stdlib_system, only: process_type, run, runasync, is_running, wait, update, elapsed, is_windows, kill implicit none @@ -39,7 +39,7 @@ subroutine test_run_asynchronous(error) logical :: running ! The closest possible to a cross-platform command that waits - if (has_win32()) then + if (is_windows()) then process = runasync("ping -n 2 127.0.0.1") else process = runasync("ping -c 2 127.0.0.1") @@ -67,7 +67,7 @@ subroutine test_process_kill(error) logical :: running, success ! Start a long-running process asynchronously - if (has_win32()) then + if (is_windows()) then process = runasync("ping -n 10 127.0.0.1") else process = runasync("ping -c 10 127.0.0.1") From d1a47153934946485a7dfaa6b3e43dea53a5ba47 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 28 Jan 2025 20:17:37 +0100 Subject: [PATCH 40/52] Update example_process_4.f90 --- example/system/example_process_4.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/example/system/example_process_4.f90 b/example/system/example_process_4.f90 index f72d9f953..43c8a615b 100644 --- a/example/system/example_process_4.f90 +++ b/example/system/example_process_4.f90 @@ -1,12 +1,12 @@ ! Process example 4: Kill a running process program example_process_kill - use stdlib_system, only: process_type, runasync, is_running, kill, elapsed, has_win32, sleep + 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 (has_win32()) then + if (is_windows()) then process = runasync("ping -n 10 127.0.0.1") else process = runasync("ping -c 10 127.0.0.1") From 7653cc40582fecb9847a264261c856bc2ec89e15 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 4 Feb 2025 09:50:12 +0100 Subject: [PATCH 41/52] add object oriented interface --- src/stdlib_system.F90 | 22 ++++++++++++++++++++-- src/stdlib_system_subprocess.F90 | 6 +++--- 2 files changed, 23 insertions(+), 5 deletions(-) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 089033279..7429d3a99 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -52,6 +52,23 @@ module stdlib_system !> Store time at the last update integer(TICKS) :: last_update = 0 +contains + + !! Check if process is still running + procedure :: is_running => process_is_running + + !! Check if process is completed + procedure :: is_completed => process_is_completed + + !! Return elapsed time since inception + procedure :: elapsed => process_lifetime + + !! Update process state internals + procedure :: update => update_process_state + + !! Kill a process + procedure :: kill => process_kill + end type process_type interface runasync @@ -142,6 +159,7 @@ module function run_sync_args(args, stdin, want_stdout, want_stderr) result(proc !> The output process handler. type(process_type) :: process end function run_sync_args + end interface run interface is_running @@ -264,7 +282,7 @@ end subroutine wait_for_completion !! module subroutine update_process_state(process) !> The process object whose state needs to be updated. - type(process_type), intent(inout) :: process + class(process_type), intent(inout) :: process end subroutine update_process_state end interface update @@ -290,7 +308,7 @@ end subroutine update_process_state !! module subroutine process_kill(process, success) !> The process object to be terminated. - type(process_type), intent(inout) :: process + class(process_type), intent(inout) :: process !> Boolean flag indicating whether the termination was successful. logical, intent(out) :: success end subroutine process_kill diff --git a/src/stdlib_system_subprocess.F90 b/src/stdlib_system_subprocess.F90 index b659513d1..b648aa15c 100644 --- a/src/stdlib_system_subprocess.F90 +++ b/src/stdlib_system_subprocess.F90 @@ -369,7 +369,7 @@ end subroutine wait_for_completion !> Update a process's state, and save it to the process variable module subroutine update_process_state(process) - type(process_type), intent(inout) :: process + class(process_type), intent(inout) :: process real(RTICKS) :: count_rate integer(TICKS) :: count_max,current_time @@ -407,7 +407,7 @@ end subroutine update_process_state ! Kill a process module subroutine process_kill(process, success) - type(process_type), intent(inout) :: process + class(process_type), intent(inout) :: process ! Return a boolean flag for successful operation logical, intent(out) :: success @@ -439,7 +439,7 @@ module subroutine process_kill(process, success) end subroutine process_kill subroutine save_completed_state(process,delete_files) - type(process_type), intent(inout) :: process + class(process_type), intent(inout) :: process logical, intent(in) :: delete_files logical(c_bool) :: running From 06c713604bbf48f92bedadf7640dfd7b909aedc6 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 4 Feb 2025 10:02:07 +0100 Subject: [PATCH 42/52] add oop example --- example/system/CMakeLists.txt | 1 + example/system/example_process_5.f90 | 25 +++++++++++++++++++++++++ 2 files changed, 26 insertions(+) create mode 100644 example/system/example_process_5.f90 diff --git a/example/system/CMakeLists.txt b/example/system/CMakeLists.txt index 87a76a5a0..7758b021c 100644 --- a/example/system/CMakeLists.txt +++ b/example/system/CMakeLists.txt @@ -2,3 +2,4 @@ ADD_EXAMPLE(process_1) ADD_EXAMPLE(process_2) ADD_EXAMPLE(process_3) ADD_EXAMPLE(process_4) +ADD_EXAMPLE(process_5) diff --git a/example/system/example_process_5.f90 b/example/system/example_process_5.f90 new file mode 100644 index 000000000..c3ff8eb29 --- /dev/null +++ b/example/system/example_process_5.f90 @@ -0,0 +1,25 @@ +! Process example 5: Object-oriented interface +program example_process_5 + use stdlib_system, only: process_type, runasync, is_windows, sleep + 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()) + + ! 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%id," completed in ",process%elapsed()," seconds." + +end program example_process_5 From f40a547b2a39a5e74eeddb25dca73a270aa751a8 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 4 Feb 2025 10:06:00 +0100 Subject: [PATCH 43/52] process ID (`pid`) getter interface --- example/system/example_process_5.f90 | 2 +- src/stdlib_system.F90 | 7 +++++++ src/stdlib_system_subprocess.F90 | 6 ++++++ 3 files changed, 14 insertions(+), 1 deletion(-) diff --git a/example/system/example_process_5.f90 b/example/system/example_process_5.f90 index c3ff8eb29..881aaa2b4 100644 --- a/example/system/example_process_5.f90 +++ b/example/system/example_process_5.f90 @@ -20,6 +20,6 @@ program example_process_5 end do - print *, "Process ",process%id," completed in ",process%elapsed()," seconds." + print *, "Process ",process%pid()," completed in ",process%elapsed()," seconds." end program example_process_5 diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 7429d3a99..7a8d5aa18 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -69,6 +69,9 @@ module stdlib_system !! Kill a process procedure :: kill => process_kill + !! Get process ID + procedure :: pid => process_get_ID + end type process_type interface runasync @@ -363,6 +366,10 @@ end subroutine sleep module logical function is_windows() end function is_windows + module integer(process_ID) function process_get_ID(process) result(ID) + class(process_type), intent(in) :: process + end function process_get_ID + end interface end module stdlib_system diff --git a/src/stdlib_system_subprocess.F90 b/src/stdlib_system_subprocess.F90 index b648aa15c..5b7f43bee 100644 --- a/src/stdlib_system_subprocess.F90 +++ b/src/stdlib_system_subprocess.F90 @@ -706,4 +706,10 @@ function getfile(fileName,err,delete) result(file) end function getfile + !> Return process ID + integer(procesS_ID) function process_get_ID(process) result(ID) + class(process_type), intent(in) :: process + ID = process%id + end function process_get_ID + end submodule stdlib_system_subprocess From d2ee2f28b7b859a8341e1fd7c475208389b1b27f Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 4 Feb 2025 10:28:29 +0100 Subject: [PATCH 44/52] implement callback --- src/stdlib_system.F90 | 51 ++++++++++++++++++--- src/stdlib_system_subprocess.F90 | 76 +++++++++++++++++++++++++------- 2 files changed, 106 insertions(+), 21 deletions(-) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 7a8d5aa18..bf0496aaf 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -37,8 +37,9 @@ module stdlib_system logical :: completed = .false. integer(TICKS) :: start_time = 0 - !> Stdin file name + !> Standard input character(:), allocatable :: stdin_file + character(:), allocatable :: stdin !> Standard output character(:), allocatable :: stdout_file @@ -49,6 +50,12 @@ module stdlib_system character(:), allocatable :: stderr_file character(:), allocatable :: stderr + !> Callback function + procedure(process_callback), nopass, pointer :: oncomplete => null() + + !> Optional payload for the callback function + class(*), pointer :: payload => null() + !> Store time at the last update integer(TICKS) :: last_update = 0 @@ -90,9 +97,9 @@ module stdlib_system !! Processes can be executed via a single command string or a list of arguments, with options to collect !! standard output and error streams, or to provide a standard input stream via a `character` string. !! - !! @note The implementation depends on system-level process management capabilities. + !! @note The implementation depends on system-level process management capabilitiesa !! - module function run_async_cmd(cmd, stdin, want_stdout, want_stderr) result(process) + module function run_async_cmd(cmd, stdin, want_stdout, want_stderr, callback, payload) result(process) !> The command line string to execute. character(*), intent(in) :: cmd !> Optional input sent to the process via standard input (stdin). @@ -101,11 +108,16 @@ module function run_async_cmd(cmd, stdin, want_stdout, want_stderr) result(proce logical, optional, intent(in) :: want_stdout !> Whether to collect standard error output. logical, optional, intent(in) :: want_stderr + !> Optional callback function to be called on process completion + procedure(process_callback), optional :: callback + !> Optional payload to pass to the callback on completion + class(*), optional, intent(inout), target :: payload !> The output process handler. type(process_type) :: process + end function run_async_cmd - module function run_async_args(args, stdin, want_stdout, want_stderr) result(process) + module function run_async_args(args, stdin, want_stdout, want_stderr, callback, payload) result(process) !> List of arguments for the process to execute. character(*), intent(in) :: args(:) !> Optional input sent to the process via standard input (stdin). @@ -114,6 +126,10 @@ module function run_async_args(args, stdin, want_stdout, want_stderr) result(pro logical, optional, intent(in) :: want_stdout !> Whether to collect standard error output. logical, optional, intent(in) :: want_stderr + !> Optional callback function to be called on process completion + procedure(process_callback), optional :: callback + !> Optional payload to pass to the callback on completion + class(*), optional, intent(inout), target :: payload !> The output process handler. type(process_type) :: process end function run_async_args @@ -137,7 +153,7 @@ end function run_async_args !! !! @note The implementation depends on system-level process management capabilities. !! - module function run_sync_cmd(cmd, stdin, want_stdout, want_stderr) result(process) + module function run_sync_cmd(cmd, stdin, want_stdout, want_stderr, callback, payload) result(process) !> The command line string to execute. character(*), intent(in) :: cmd !> Optional input sent to the process via standard input (stdin). @@ -146,11 +162,15 @@ module function run_sync_cmd(cmd, stdin, want_stdout, want_stderr) result(proces logical, optional, intent(in) :: want_stdout !> Whether to collect standard error output. logical, optional, intent(in) :: want_stderr + !> Optional callback function to be called on process completion + procedure(process_callback), optional :: callback + !> Optional payload to pass to the callback on completion + class(*), optional, intent(inout), target :: payload !> The output process handler. type(process_type) :: process end function run_sync_cmd - module function run_sync_args(args, stdin, want_stdout, want_stderr) result(process) + module function run_sync_args(args, stdin, want_stdout, want_stderr, callback, payload) result(process) !> List of arguments for the process to execute. character(*), intent(in) :: args(:) !> Optional input sent to the process via standard input (stdin). @@ -159,6 +179,10 @@ module function run_sync_args(args, stdin, want_stdout, want_stderr) result(proc logical, optional, intent(in) :: want_stdout !> Whether to collect standard error output. logical, optional, intent(in) :: want_stderr + !> Optional callback function to be called on process completion + procedure(process_callback), optional :: callback + !> Optional payload to pass to the callback on completion + class(*), optional, intent(inout), target :: payload !> The output process handler. type(process_type) :: process end function run_sync_args @@ -342,6 +366,21 @@ module subroutine sleep(millisec) end subroutine sleep end interface sleep +abstract interface + subroutine process_callback(pid,exit_state,stdin,stdout,stderr,payload) + import process_ID + implicit none + !> Process ID + integer(process_ID), intent(in) :: pid + !> Process return state + integer, intent(in) :: exit_state + !> Process input/output: presence of these arguments depends on how process was created + character(len=*), optional, intent(in) :: stdin,stdout,stderr + !> Optional payload passed by the user on process creation + class(*), optional, intent(inout) :: payload + end subroutine process_callback +end interface + interface !! version: experimental diff --git a/src/stdlib_system_subprocess.F90 b/src/stdlib_system_subprocess.F90 index 5b7f43bee..2d63100cb 100644 --- a/src/stdlib_system_subprocess.F90 +++ b/src/stdlib_system_subprocess.F90 @@ -1,7 +1,6 @@ submodule (stdlib_system) stdlib_system_subprocess use iso_c_binding use iso_fortran_env, only: int64, real64 - use stdlib_system use stdlib_strings, only: to_c_string, join use stdlib_linalg_state, only: linalg_state_type, LINALG_ERROR, linalg_error_handling implicit none(type, external) @@ -85,7 +84,7 @@ module subroutine sleep(millisec) end subroutine sleep - module function run_async_cmd(cmd, stdin, want_stdout, want_stderr) result(process) + module function run_async_cmd(cmd, stdin, want_stdout, want_stderr, callback, payload) result(process) !> The command line string to execute. character(*), intent(in) :: cmd !> Optional input sent to the process via standard input (stdin). @@ -94,14 +93,18 @@ module function run_async_cmd(cmd, stdin, want_stdout, want_stderr) result(proce logical, optional, intent(in) :: want_stdout !> Whether to collect standard error output. logical, optional, intent(in) :: want_stderr + !> Optional callback function to be called on process completion + procedure(process_callback), optional :: callback + !> Optional payload to pass to the callback on completion + class(*), optional, intent(inout), target :: payload !> The output process handler. type(process_type) :: process - process = process_open([cmd],.false.,stdin,want_stdout,want_stderr) + process = process_open([cmd],.false.,stdin,want_stdout,want_stderr,callback,payload) end function run_async_cmd - module function run_async_args(args, stdin, want_stdout, want_stderr) result(process) + module function run_async_args(args, stdin, want_stdout, want_stderr, callback, payload) result(process) !> List of arguments for the process to execute. character(*), intent(in) :: args(:) !> Optional input sent to the process via standard input (stdin). @@ -110,14 +113,18 @@ module function run_async_args(args, stdin, want_stdout, want_stderr) result(pro logical, optional, intent(in) :: want_stdout !> Whether to collect standard error output. logical, optional, intent(in) :: want_stderr + !> Optional callback function to be called on process completion + procedure(process_callback), optional :: callback + !> Optional payload to pass to the callback on completion + class(*), optional, intent(inout), target :: payload !> The output process handler. type(process_type) :: process - process = process_open(args,.false.,stdin,want_stdout,want_stderr) + process = process_open(args,.false.,stdin,want_stdout,want_stderr,callback,payload) end function run_async_args - module function run_sync_cmd(cmd, stdin, want_stdout, want_stderr) result(process) + module function run_sync_cmd(cmd, stdin, want_stdout, want_stderr, callback, payload) result(process) !> The command line string to execute. character(*), intent(in) :: cmd !> Optional input sent to the process via standard input (stdin). @@ -126,14 +133,18 @@ module function run_sync_cmd(cmd, stdin, want_stdout, want_stderr) result(proces logical, optional, intent(in) :: want_stdout !> Whether to collect standard error output. logical, optional, intent(in) :: want_stderr + !> Optional callback function to be called on process completion + procedure(process_callback), optional :: callback + !> Optional payload to pass to the callback on completion + class(*), optional, intent(inout), target :: payload !> The output process handler. type(process_type) :: process - process = process_open([cmd],.true.,stdin,want_stdout,want_stderr) + process = process_open([cmd],.true.,stdin,want_stdout,want_stderr,callback,payload) end function run_sync_cmd - module function run_sync_args(args, stdin, want_stdout, want_stderr) result(process) + module function run_sync_args(args, stdin, want_stdout, want_stderr, callback, payload) result(process) !> List of arguments for the process to execute. character(*), intent(in) :: args(:) !> Optional input sent to the process via standard input (stdin). @@ -142,15 +153,19 @@ module function run_sync_args(args, stdin, want_stdout, want_stderr) result(proc logical, optional, intent(in) :: want_stdout !> Whether to collect standard error output. logical, optional, intent(in) :: want_stderr + !> Optional callback function to be called on process completion + procedure(process_callback), optional :: callback + !> Optional payload to pass to the callback on completion + class(*), optional, intent(inout), target :: payload !> The output process handler. type(process_type) :: process - process = process_open(args,.true.,stdin,want_stdout,want_stderr) + process = process_open(args,.true.,stdin,want_stdout,want_stderr,callback,payload) end function run_sync_args !> Internal function: open a new process from a command line - function process_open_cmd(cmd,wait,stdin,want_stdout,want_stderr) result(process) + function process_open_cmd(cmd,wait,stdin,want_stdout,want_stderr,callback,payload) result(process) !> The command and arguments character(*), intent(in) :: cmd !> Optional character input to be sent to the process via pipe @@ -159,15 +174,19 @@ function process_open_cmd(cmd,wait,stdin,want_stdout,want_stderr) result(process logical, intent(in) :: wait !> Require collecting output logical, optional, intent(in) :: want_stdout, want_stderr + !> Optional callback function to be called on process completion + procedure(process_callback), optional :: callback + !> Optional payload to pass to the callback on completion + class(*), optional, intent(inout), target :: payload !> The output process handler type(process_type) :: process - process = process_open([cmd],wait,stdin,want_stdout,want_stderr) + process = process_open([cmd],wait,stdin,want_stdout,want_stderr,callback,payload) end function process_open_cmd !> Internal function: open a new process from arguments - function process_open(args,wait,stdin,want_stdout,want_stderr) result(process) + function process_open(args,wait,stdin,want_stdout,want_stderr,callback,payload) result(process) !> The command and arguments character(*), intent(in) :: args(:) !> Optional character input to be sent to the process via pipe @@ -176,6 +195,10 @@ function process_open(args,wait,stdin,want_stdout,want_stderr) result(process) logical, intent(in) :: wait !> Require collecting output logical, optional, intent(in) :: want_stdout, want_stderr + !> Optional callback function to be called on process completion + procedure(process_callback), optional :: callback + !> Optional payload to pass to the callback on completion + class(*), optional, intent(inout), target :: payload !> The output process handler type(process_type) :: process @@ -197,6 +220,19 @@ function process_open(args,wait,stdin,want_stdout,want_stderr) result(process) if (collect_stdout) process%stdout_file = scratch_name('out') if (collect_stderr) process%stderr_file = scratch_name('err') + ! Attach callback function and payload + if (present(callback)) then + process%oncomplete => callback + else + nullify(process%oncomplete) + end if + + if (present(payload)) then + process%payload => payload + else + nullify(process%payload) + end if + ! Save the process's generation time call system_clock(process%start_time,count_rate,count_max) process%last_update = process%start_time @@ -452,23 +488,33 @@ subroutine save_completed_state(process,delete_files) ! Clean up process state using waitpid if (process%id/=FORKED_PROCESS) call process_query_status(process%id, C_TRUE, running, exit_code) - ! Process is over: load stdout/stderr if requested + ! Process is over: load stderr if requested if (allocated(process%stderr_file)) then process%stderr = getfile(process%stderr_file,delete=delete_files) deallocate(process%stderr_file) endif + ! Process is over: load stdout if requested if (allocated(process%stdout_file)) then process%stdout = getfile(process%stdout_file,delete=delete_files) deallocate(process%stdout_file) endif + ! Process is over: delete stdin file if it was provided if (allocated(process%stdin_file)) then - open(newunit=delete,file=process%stdin_file,access='stream',action='write') - close(delete,status='delete') + process%stdin = getfile(process%stdin_file,delete=delete_files) deallocate(process%stdin_file) end if + ! Process is over: invoke callback if requested + if (associated(process%oncomplete)) & + call process%oncomplete(process%id, & + process%exit_code, & + process%stderr, & + process%stdout, & + process%stderr, & + process%payload) + end subroutine save_completed_state !> Live check if a process is running From 3f08a8ba70234acce8ae26b6f313a2d06b5c3c8f Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 4 Feb 2025 10:42:11 +0100 Subject: [PATCH 45/52] add callback example --- example/system/CMakeLists.txt | 1 + example/system/example_process_6.f90 | 45 ++++++++++++++++++++++++++++ 2 files changed, 46 insertions(+) create mode 100644 example/system/example_process_6.f90 diff --git a/example/system/CMakeLists.txt b/example/system/CMakeLists.txt index 7758b021c..ffc963fdd 100644 --- a/example/system/CMakeLists.txt +++ b/example/system/CMakeLists.txt @@ -3,3 +3,4 @@ ADD_EXAMPLE(process_2) ADD_EXAMPLE(process_3) ADD_EXAMPLE(process_4) ADD_EXAMPLE(process_5) +ADD_EXAMPLE(process_6) diff --git a/example/system/example_process_6.f90 b/example/system/example_process_6.f90 new file mode 100644 index 000000000..fa64d3044 --- /dev/null +++ b/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 From d694dcfd19d81a4d758c95c7f9f6b3b00a92fa09 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 4 Feb 2025 10:43:32 +0100 Subject: [PATCH 46/52] fix submodule --- src/stdlib_system_subprocess.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_system_subprocess.F90 b/src/stdlib_system_subprocess.F90 index 2d63100cb..362dd5a49 100644 --- a/src/stdlib_system_subprocess.F90 +++ b/src/stdlib_system_subprocess.F90 @@ -753,7 +753,7 @@ function getfile(fileName,err,delete) result(file) end function getfile !> Return process ID - integer(procesS_ID) function process_get_ID(process) result(ID) + module integer(procesS_ID) function process_get_ID(process) result(ID) class(process_type), intent(in) :: process ID = process%id end function process_get_ID From 80a2d0a29bfaf61a3830273d8de17b57053ed303 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 4 Feb 2025 10:47:29 +0100 Subject: [PATCH 47/52] intel fix: no inline type --- src/stdlib_system.F90 | 4 +++- src/stdlib_system_subprocess.F90 | 4 +++- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index bf0496aaf..dfc07ec48 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -405,8 +405,10 @@ end subroutine process_callback module logical function is_windows() end function is_windows - module integer(process_ID) function process_get_ID(process) result(ID) + module function process_get_ID(process) result(ID) class(process_type), intent(in) :: process + !> Return a process ID + integer(process_ID) :: ID end function process_get_ID end interface diff --git a/src/stdlib_system_subprocess.F90 b/src/stdlib_system_subprocess.F90 index 362dd5a49..5a83a7f84 100644 --- a/src/stdlib_system_subprocess.F90 +++ b/src/stdlib_system_subprocess.F90 @@ -753,8 +753,10 @@ function getfile(fileName,err,delete) result(file) end function getfile !> Return process ID - module integer(procesS_ID) function process_get_ID(process) result(ID) + module function process_get_ID(process) result(ID) class(process_type), intent(in) :: process + !> Return a process ID + integer(process_ID) :: ID ID = process%id end function process_get_ID From 20c045d2562cb78d1aa3d8ebf02d3ea67996d71e Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 4 Feb 2025 11:02:26 +0100 Subject: [PATCH 48/52] document callback and payload functionality --- doc/specs/stdlib_system.md | 17 +++++++++++++---- src/stdlib_system.F90 | 23 ++++++++++++++++++++--- 2 files changed, 33 insertions(+), 7 deletions(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index ae267fedb..aaf2150e3 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -19,11 +19,12 @@ Experimental 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. +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])` +`process = ` [[stdlib_subprocess(module):run(interface)]] `(args [, stdin] [, want_stdout] [, want_stderr] [, callback] [, payload])` ### Arguments @@ -35,6 +36,10 @@ Optional arguments enable the collection of standard output and error streams, a `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. @@ -49,7 +54,6 @@ type(process_type) :: p p = run("echo 'Hello, world!'", want_stdout=.true.) ``` - ## `runasync` - Execute an external process asynchronously ### Status @@ -61,10 +65,11 @@ Experimental 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])` +`process = ` [[stdlib_subprocess(module):runasync(interface)]] `(args [, stdin] [, want_stdout] [, want_stderr] [, callback] [, payload])` ### Arguments @@ -76,6 +81,10 @@ Optional arguments enable the collection of standard output and error streams, a `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. diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index dfc07ec48..3c7858506 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -85,7 +85,7 @@ module stdlib_system !! version: experimental !! !! Executes an external process asynchronously. - !! ([Specification](../page/specs/stdlib_system.html#run-execute-an-external-process-asynchronously)) + !! ([Specification](../page/specs/stdlib_system.html#runasync-execute-an-external-process-asynchronously)) !! !! ### Summary !! Provides methods for executing external processes asynchronously, using either a single command string @@ -96,8 +96,10 @@ module stdlib_system !! This interface allows the user to spawn external processes asynchronously (non-blocking). !! Processes can be executed via a single command string or a list of arguments, with options to collect !! standard output and error streams, or to provide a standard input stream via a `character` string. + !! Additionally, a callback function can be provided, which will be called upon process completion. + !! A user-defined payload can be attached and passed to the callback for handling process-specific data. !! - !! @note The implementation depends on system-level process management capabilitiesa + !! @note The implementation depends on system-level process management capabilities. !! module function run_async_cmd(cmd, stdin, want_stdout, want_stderr, callback, payload) result(process) !> The command line string to execute. @@ -139,7 +141,7 @@ end function run_async_args !! version: experimental !! !! Executes an external process synchronously. - !! ([Specification](../page/specs/stdlib_system.html#runasync-execute-an-external-process-synchronously)) + !! ([Specification](../page/specs/stdlib_system.html#run-execute-an-external-process-synchronously)) !! !! ### Summary !! Provides methods for executing external processes synchronously, using either a single command string @@ -150,6 +152,9 @@ end function run_async_args !! This interface allows the user to spawn external processes synchronously (blocking), !! via either a single command string or a list of arguments. It also includes options to collect !! standard output and error streams, or to provide a standard input stream via a `character` string. + !! Additionally, it supports an optional callback function that is invoked upon process completion, + !! allowing users to process results dynamically. A user-defined payload can also be provided, + !! which is passed to the callback function to facilitate contextual processing. !! !! @note The implementation depends on system-level process management capabilities. !! @@ -367,6 +372,18 @@ end subroutine sleep end interface sleep abstract interface + + !! version: experimental + !! + !! Process callback interface + !! + !! ### Summary + !! + !! The `process_callback` interface defines a user-provided subroutine that will be called + !! upon process completion. It provides access to process metadata, including the process ID, + !! exit state, and optional input/output streams. If passed on creation, a generic payload can be + !! accessed by the callback function. This variable must be a valid `target` in the calling scope. + !! subroutine process_callback(pid,exit_state,stdin,stdout,stderr,payload) import process_ID implicit none From 33f81a30e714d7eac04842189f3d13bef239c727 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 17 Feb 2025 01:16:42 -0600 Subject: [PATCH 49/52] `to_c_string` -> `to_c_char` --- src/stdlib_system_subprocess.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/stdlib_system_subprocess.F90 b/src/stdlib_system_subprocess.F90 index 5a83a7f84..00f5d759a 100644 --- a/src/stdlib_system_subprocess.F90 +++ b/src/stdlib_system_subprocess.F90 @@ -1,7 +1,7 @@ submodule (stdlib_system) stdlib_system_subprocess use iso_c_binding use iso_fortran_env, only: int64, real64 - use stdlib_strings, only: to_c_string, join + use stdlib_strings, only: to_c_char, join use stdlib_linalg_state, only: linalg_state_type, LINALG_ERROR, linalg_error_handling implicit none(type, external) @@ -284,11 +284,11 @@ subroutine launch_asynchronous(process, args, stdin) character(c_char), dimension(:), allocatable, target :: c_cmd,c_stdin,c_stdin_file,c_stdout_file,c_stderr_file ! Assemble C strings - c_cmd = to_c_string(join(args)) - if (present(stdin)) c_stdin = to_c_string(stdin) - if (allocated(process%stdin_file)) c_stdin_file = to_c_string(process%stdin_file) - if (allocated(process%stdout_file)) c_stdout_file = to_c_string(process%stdout_file) - if (allocated(process%stderr_file)) c_stderr_file = to_c_string(process%stderr_file) + c_cmd = to_c_char(join(args)) + if (present(stdin)) c_stdin = to_c_char(stdin) + if (allocated(process%stdin_file)) c_stdin_file = to_c_char(process%stdin_file) + if (allocated(process%stdout_file)) c_stdout_file = to_c_char(process%stdout_file) + if (allocated(process%stderr_file)) c_stderr_file = to_c_char(process%stderr_file) ! On Windows, this 1) creates 2) launches an external process from C. ! On unix, this 1) forks an external process From deabd0cf815da8650a2feee318ac0364f50f4d85 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 17 Feb 2025 01:28:51 -0600 Subject: [PATCH 50/52] Update doc/specs/stdlib_system.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_system.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index aaf2150e3..649fa7b54 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -79,7 +79,7 @@ Additionally, a callback function can be specified to execute upon process compl `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. +`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. From f55ddb79a940142ba49e84da5e5f34739a2324a5 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 17 Feb 2025 01:29:04 -0600 Subject: [PATCH 51/52] Update doc/specs/stdlib_system.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_system.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index 649fa7b54..d64fa06f9 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -34,7 +34,7 @@ Additionally, a callback function can be specified to execute upon process compl `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. +`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. From d4422cf3d479e52ac8281e5bccf706403fa5430f Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 17 Feb 2025 01:46:23 -0600 Subject: [PATCH 52/52] move all examples to separate files --- doc/specs/stdlib_system.md | 108 +++------------------------ example/system/CMakeLists.txt | 2 + example/system/example_process_5.f90 | 5 +- example/system/example_process_7.f90 | 21 ++++++ example/system/example_sleep.f90 | 13 ++++ 5 files changed, 49 insertions(+), 100 deletions(-) create mode 100644 example/system/example_process_7.f90 create mode 100644 example/system/example_sleep.f90 diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index aaf2150e3..baba517ce 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -92,14 +92,7 @@ Returns an object of type `process_type` that contains information about the sta ### Example ```fortran -! Example usage with command line or list of arguments -type(process_type) :: p(2) - -! Run a simple command line asynchronously -p(1) = runasync("echo 'Hello, world!'", want_stdout=.true.) - -! Run a command using an argument list asynchronously -p(2) = runasync(["/usr/bin/ls", "-l"], want_stdout=.true.) +{!example/system/example_process_1.f90!} ``` ## `is_running` - Check if a process is still running @@ -130,21 +123,7 @@ After a call to `is_running`, the `type(process_type)` structure is also updated ### Example ```fortran -! Example usage of is_running -type(process_type) :: proc -logical :: status - -! Start an asynchronous process -proc = run("sleep 10", wait=.false.) - -! Check if the process is running -status = is_running(proc) - -if (status) then - print *, "Process is still running." -else - print *, "Process has terminated." -end if +{!example/system/example_process_2.f90!} ``` ## `is_completed` - Check if a process has completed execution @@ -177,21 +156,7 @@ After a call to `is_completed`, the `type(process_type)` structure is updated to ### Example ```fortran -! Example usage of is_completed -type(process_type) :: proc -logical :: status - -! Start an asynchronous process -proc = run("sleep 5", wait=.false.) - -! Check if the process has completed -status = is_completed(proc) - -if (status) then - print *, "Process has completed." -else - print *, "Process is still running." -end if +{!example/system/example_process_1.f90!} ``` ## `elapsed` - Return process lifetime in seconds @@ -224,17 +189,7 @@ Otherwise, the total process duration from creation until completion is returned ### Example ```fortran -! Example usage of elapsed -type(process_type) :: p -real(RTICKS) :: delta_t - -! Create a process -p = run("sleep 5", wait=.false.) - -! Check elapsed time after 2 seconds -call sleep(2) -delta_t = elapsed(p) -print *, "Elapsed time (s): ", delta_t +{!example/system/example_process_3.f90!} ``` ## `wait` - Wait until a running process is completed @@ -270,15 +225,7 @@ If not provided, the subroutine will wait indefinitely until the process complet ### Example ```fortran -! Example usage of wait -type(process_type) :: p - -! Start an asynchronous process -p = run("sleep 5", wait=.false.) - -! Wait for process to complete with a 10-second timeout -call wait(p, max_wait_time=10.0) -print *, "Process completed or timed out." +{!example/system/example_process_2.f90!} ``` ## `update` - Update the internal state of a process @@ -306,20 +253,7 @@ This is an `intent(inout)` argument, and its internal state is updated on comple ### Example ```fortran -! Example usage of update -type(process_type) :: p - -! Start an asynchronous process -p = run("sleep 5", wait=.false., want_stdout=.true., want_stderr=.true.) - -! Periodically update the process state -call update(p) - -! After completion, print the captured stdout and stderr -if (p%completed) then - print *, "Standard Output: ", p%stdout - print *, "Standard Error: ", p%stderr -endif +{!example/system/example_process_5.f90!} ``` ## `kill` - Terminate a running process @@ -347,21 +281,7 @@ This is an `intent(inout)` argument, and on return is updated with the terminate ### Example ```fortran -! Example usage of kill -type(process_type) :: p -logical :: success - -! Start a process asynchronously -p = run("sleep 10", wait=.false.) - -! 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 +{!example/system/example_process_4.f90!} ``` ## `sleep` - Pause execution for a specified time in milliseconds @@ -387,13 +307,7 @@ It ensures that the requested sleep duration is honored on both Windows and Unix ### Example ```fortran -! Example usage of sleep -print *, "Starting sleep..." - -! Sleep for 500 milliseconds -call sleep(500) - -print *, "Finished sleeping!" +{!example/system/example_sleep.f90!} ``` ## `is_windows` - Check if the system is running on Windows @@ -419,9 +333,5 @@ Returns a `logical` flag: `.true.` if the system is Windows, or `.false.` otherw ### Example ```fortran -if (is_windows()) then - print *, "Running on Windows!" -else - print *, "Not running on Windows." -end if +{!example/system/example_process_1.f90!} ``` diff --git a/example/system/CMakeLists.txt b/example/system/CMakeLists.txt index ffc963fdd..5b4ef4054 100644 --- a/example/system/CMakeLists.txt +++ b/example/system/CMakeLists.txt @@ -4,3 +4,5 @@ ADD_EXAMPLE(process_3) ADD_EXAMPLE(process_4) ADD_EXAMPLE(process_5) ADD_EXAMPLE(process_6) +ADD_EXAMPLE(process_7) +ADD_EXAMPLE(sleep) diff --git a/example/system/example_process_5.f90 b/example/system/example_process_5.f90 index 881aaa2b4..66d8e2ff8 100644 --- a/example/system/example_process_5.f90 +++ b/example/system/example_process_5.f90 @@ -1,6 +1,6 @@ ! Process example 5: Object-oriented interface program example_process_5 - use stdlib_system, only: process_type, runasync, is_windows, sleep + use stdlib_system, only: process_type, runasync, is_windows, sleep, update implicit none type(process_type) :: process @@ -13,6 +13,9 @@ program example_process_5 ! 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) diff --git a/example/system/example_process_7.f90 b/example/system/example_process_7.f90 new file mode 100644 index 000000000..91b441396 --- /dev/null +++ b/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 diff --git a/example/system/example_sleep.f90 b/example/system/example_sleep.f90 new file mode 100644 index 000000000..75fdf165d --- /dev/null +++ b/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