Skip to content

Commit cf35194

Browse files
perazzperazz
committed
create submodule
1 parent 1449b8d commit cf35194

File tree

2 files changed

+116
-73
lines changed

2 files changed

+116
-73
lines changed

‎src/stdlib_system.F90

Lines changed: 96 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,101 @@
11
module stdlib_system
2-
use, intrinsic :: iso_c_binding, only : c_int, c_long
2+
use, intrinsic :: iso_c_binding, only : c_int, c_long, c_null_ptr, c_int64_t
3+
use, intrinsic :: iso_c_binding, only : process_handle => c_ptr, null_process => c_null_ptr
4+
use stdlib_kinds, only: int64, dp
35
implicit none
46
private
57
public :: sleep
68

9+
!> Public sub-processing interface
10+
public :: run
11+
public :: process_type
12+
public :: is_completed
13+
public :: is_running
14+
15+
! CPU clock ticks storage
16+
integer, parameter, private :: TICKS = int64
17+
integer, parameter, private :: RTICKS = dp
18+
19+
! Interoperable types to the C backend
20+
integer, parameter, public :: process_ID = c_int64_t
21+
22+
! Default flag for the runner process
23+
integer(process_ID), parameter, private :: FORKED_PROCESS = 0_process_ID
24+
25+
! Public type to describe a process
26+
type :: process_type
27+
28+
!> Process ID (if external); 0 if run by the program process
29+
integer(process_ID) :: id = FORKED_PROCESS
30+
type(process_handle) :: handle = null_process
31+
32+
!> Process is completed
33+
logical :: completed = .false.
34+
integer(TICKS) :: start_time = 0
35+
36+
!> Process exit code
37+
integer :: exit_code = 0
38+
39+
!> Stdin file name
40+
character(:), allocatable :: stdin_file
41+
42+
!> Standard output
43+
character(:), allocatable :: stdout_file
44+
character(:), allocatable :: stdout
45+
46+
!> Error output
47+
character(:), allocatable :: stderr_file
48+
character(:), allocatable :: stderr
49+
50+
!> Store time at the last update
51+
integer(TICKS) :: last_update = 0
52+
53+
end type process_type
54+
55+
interface run
56+
!> Open a new, asynchronous process
57+
module type(process_type) function process_open(args,wait,stdin,want_stdout,want_stderr) result(process)
58+
!> The command and arguments
59+
character(*), intent(in) :: args(:)
60+
!> Optional character input to be sent to the process via pipe
61+
character(*), optional, intent(in) :: stdin
62+
!> Define if the process should be synchronous (wait=.true.), or asynchronous(wait=.false.)
63+
logical, optional, intent(in) :: wait
64+
!> Require collecting output
65+
logical, optional, intent(in) :: want_stdout, want_stderr
66+
end function process_open
67+
end interface run
68+
69+
!> Live check if a process is still running
70+
interface is_running
71+
module logical function process_is_running(process) result(is_running)
72+
class(process_type), intent(inout) :: process
73+
end function process_is_running
74+
end interface is_running
75+
76+
!> Live check if a process is still running
77+
interface is_completed
78+
module logical function process_is_completed(process) result(is_completed)
79+
class(process_type), intent(inout) :: process
80+
end function process_is_completed
81+
end interface is_completed
82+
83+
!> Return process lifetime so far, in seconds
84+
interface elapsed
85+
module real(RTICKS) function process_lifetime(process) result(delta_t)
86+
class(process_type), intent(in) :: process
87+
end function process_lifetime
88+
end interface elapsed
89+
90+
!> Wait until a running process is completed
91+
interface wait
92+
module subroutine wait_for_completion(process, max_wait_time)
93+
class(process_type), intent(inout) :: process
94+
! Optional max wait time in seconds
95+
real, optional, intent(in) :: max_wait_time
96+
end subroutine wait_for_completion
97+
end interface wait
98+
799
interface
8100
#ifdef _WIN32
9101
subroutine winsleep(dwMilliseconds) bind (C, name='Sleep')
@@ -26,6 +118,9 @@ end function usleep
26118
#endif
27119
end interface
28120

121+
122+
123+
29124
contains
30125

31126
subroutine sleep(millisec)

‎src/stdlib_system_subprocess.F90

Lines changed: 20 additions & 72 deletions
Original file line numberDiff line numberDiff line change
@@ -1,38 +1,27 @@
1-
module fortran_subprocess
1+
submodule (stdlib_system) stdlib_system_subprocess
22
use iso_c_binding
33
use iso_fortran_env, only: int64, real64
44
use stdlib_system
55
use stdlib_strings, only: to_c_string, join
66
use stdlib_linalg_state, only: linalg_state_type, LINALG_ERROR, linalg_error_handling
7-
implicit none
8-
public
7+
implicit none(type, external)
98

10-
! Interoperable types
11-
integer, parameter, public :: pid_t = c_int64_t
12-
13-
logical(c_bool), parameter, private :: C_FALSE = .false._c_bool
14-
logical(c_bool), parameter, private :: C_TRUE = .true._c_bool
15-
16-
! CPU clock ticks range
17-
integer, parameter, private :: TICKS = int64
18-
integer, parameter, private :: RTICKS = real64
9+
logical(c_bool), parameter :: C_FALSE = .false._c_bool
10+
logical(c_bool), parameter :: C_TRUE = .true._c_bool
1911

2012
! Number of CPU ticks between status updates
2113
integer(TICKS), parameter :: CHECK_EVERY_TICKS = 100
2214

23-
! Default flag for the runner process
24-
integer(pid_t), parameter :: FORKED_PROCESS = 0_pid_t
25-
2615
! Interface to C support functions from stdlib_system_subprocess.c
2716
interface
2817

2918
! C wrapper to query process status
3019
subroutine process_query_status(pid, wait, is_running, exit_code) &
3120
bind(C, name='process_query_status')
32-
import c_int, c_bool, pid_t
21+
import c_int, c_bool, process_ID
3322
implicit none
3423
! Process ID
35-
integer(pid_t), value :: pid
24+
integer(process_ID), value :: pid
3625
! Whether to wait for process completion
3726
logical(c_bool), value :: wait
3827
! Whether the process is still running
@@ -43,15 +32,15 @@ end subroutine process_query_status
4332

4433
subroutine process_create(cmd, stdin_stream, stdin_file, stdout_file, stderr_file, handle, pid) &
4534
bind(C, name='process_create')
46-
import c_char, c_ptr, pid_t
35+
import c_char, c_ptr, process_ID
4736
implicit none
4837
character(c_char), intent(in) :: cmd(*)
4938
character(c_char), intent(in), optional :: stdin_stream(*)
5039
character(c_char), intent(in), optional :: stdin_file(*)
5140
character(c_char), intent(in), optional :: stdout_file(*)
5241
character(c_char), intent(in), optional :: stderr_file(*)
5342
type(c_ptr) , intent(out) :: handle
54-
integer(pid_t), intent(out) :: pid
43+
integer(process_ID), intent(out) :: pid
5544
end subroutine process_create
5645

5746
subroutine process_wait(seconds) bind(C,name='process_wait')
@@ -68,52 +57,13 @@ end function process_null_device
6857

6958
end interface
7059

71-
type, public :: process_type
72-
73-
!> Process ID (if external); 0 if run by the program process
74-
integer(pid_t) :: id = FORKED_PROCESS
75-
type(c_ptr) :: handle = c_null_ptr
76-
77-
!> Process is completed
78-
logical :: completed = .false.
79-
integer(TICKS) :: start_time = 0
80-
81-
!> Process exit code
82-
integer :: exit_code = 0
83-
84-
!> Stdin file name
85-
character(:), allocatable :: stdin_file
86-
87-
!> Standard output
88-
character(:), allocatable :: stdout_file
89-
character(:), allocatable :: stdout
90-
91-
!> Error output
92-
character(:), allocatable :: stderr_file
93-
character(:), allocatable :: stderr
94-
95-
!> Store time at the last update
96-
integer(TICKS) :: last_update = 0
97-
98-
contains
99-
100-
!> Return process lifetime so far, in seconds
101-
procedure :: elapsed => process_lifetime
102-
103-
!> Live check if a process is still running
104-
procedure :: is_running => process_is_running
105-
procedure :: is_completed => process_is_completed
106-
107-
!> Wait until a running process is completed
108-
procedure :: wait => wait_for_completion
109-
110-
end type process_type
60+
11161

11262

11363
contains
11464

11565
!> Open a new, asynchronous process
116-
type(process_type) function process_open(args,wait,stdin,want_stdout,want_stderr) result(process)
66+
module type(process_type) function process_open(args,wait,stdin,want_stdout,want_stderr) result(process)
11767
!> The command and arguments
11868
character(*), intent(in) :: args(:)
11969
!> 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
178128

179129
endif
180130

181-
182-
183131
! Run a first update
184132
call update_process_state(process)
185133

@@ -249,7 +197,7 @@ subroutine launch_synchronous(process, args, stdin)
249197
end subroutine launch_synchronous
250198

251199
!> Return the current (or total) process lifetime, in seconds
252-
real(RTICKS) function process_lifetime(process) result(delta_t)
200+
module real(RTICKS) function process_lifetime(process) result(delta_t)
253201
class(process_type), intent(in) :: process
254202

255203
real(RTICKS) :: ticks_per_second
@@ -271,7 +219,7 @@ real(RTICKS) function process_lifetime(process) result(delta_t)
271219
end function process_lifetime
272220

273221
!> Wait for a process to be completed
274-
subroutine wait_for_completion(process, max_wait_time)
222+
module subroutine wait_for_completion(process, max_wait_time)
275223
class(process_type), intent(inout) :: process
276224
! Optional max wait time in seconds
277225
real, optional, intent(in) :: max_wait_time
@@ -310,7 +258,7 @@ subroutine update_process_state(process)
310258

311259
real(RTICKS) :: count_rate
312260
integer(TICKS) :: count_max,current_time
313-
logical(c_bool) :: is_running
261+
logical(c_bool) :: running
314262
integer(c_int) :: exit_code
315263

316264
! If the process has completed, should not be queried again
@@ -328,9 +276,9 @@ subroutine update_process_state(process)
328276
if (process%id /= FORKED_PROCESS) then
329277

330278
! Query process state
331-
call process_query_status(process%id, wait=C_FALSE, is_running=is_running, exit_code=exit_code)
279+
call process_query_status(process%id, wait=C_FALSE, is_running=running, exit_code=exit_code)
332280

333-
process%completed = .not.is_running
281+
process%completed = .not.running
334282

335283
if (process%completed) then
336284
! Process completed, may have returned an error code
@@ -346,15 +294,15 @@ subroutine save_completed_state(process,delete_files)
346294
type(process_type), intent(inout) :: process
347295
logical, intent(in) :: delete_files
348296

349-
logical(c_bool) :: is_running
297+
logical(c_bool) :: running
350298
integer(c_int) :: exit_code
351299
integer :: delete
352300

353301
! Same as process ID: process exited
354302
process%completed = .true.
355303

356304
! Clean up process state using waitpid
357-
if (process%id/=FORKED_PROCESS) call process_query_status(process%id, C_TRUE, is_running, exit_code)
305+
if (process%id/=FORKED_PROCESS) call process_query_status(process%id, C_TRUE, running, exit_code)
358306

359307
! Process is over: load stdout/stderr if requested
360308
if (allocated(process%stderr_file)) then
@@ -376,7 +324,7 @@ subroutine save_completed_state(process,delete_files)
376324
end subroutine save_completed_state
377325

378326
!> Live check if a process is running
379-
logical function process_is_running(process) result(is_running)
327+
module logical function process_is_running(process) result(is_running)
380328
class(process_type), intent(inout) :: process
381329

382330
! Each evaluation triggers a state update
@@ -387,7 +335,7 @@ logical function process_is_running(process) result(is_running)
387335
end function process_is_running
388336

389337
!> Live check if a process has completed
390-
logical function process_is_completed(process) result(is_completed)
338+
module logical function process_is_completed(process) result(is_completed)
391339
class(process_type), intent(inout) :: process
392340

393341
! Each evaluation triggers a state update
@@ -580,4 +528,4 @@ function getfile(fileName,err,delete) result(file)
580528

581529
end function getfile
582530

583-
end module fortran_subprocess
531+
end submodule stdlib_system_subprocess

0 commit comments

Comments
 (0)