fortsh Public

Watch 0 Fork 0 Star 0
Fortran · 3558 bytes Raw Blame History
1 ! ==============================================================================
2 ! Module: io_helpers
3 ! Purpose: C file descriptor-aware I/O helpers
4 !
5 ! This module provides I/O functions that respect C file descriptor
6 ! redirections (via dup2), unlike Fortran's standard I/O which uses
7 ! separate internal buffering and doesn't see FD changes.
8 ! ==============================================================================
9 module io_helpers
10 use iso_c_binding
11 use system_interface, only: STDOUT_FD, STDERR_FD, c_write
12 implicit none
13
14 ! Note: c_write returns c_intptr_t (signed) to detect -1 error
15
16 private
17 public :: write_stdout, write_stderr, write_stdout_nonl
18 public :: write_stdout_checked, write_stdout_nonl_checked
19
20 contains
21
22 ! Write string to stdout with newline (respects C FD redirections)
23 subroutine write_stdout(str)
24 character(len=*), intent(in) :: str
25 logical :: success
26 call write_stdout_checked(str, success)
27 end subroutine write_stdout
28
29 ! Write string to stdout with newline, returning success status
30 subroutine write_stdout_checked(str, success)
31 character(len=*), intent(in) :: str
32 logical, intent(out) :: success
33
34 character(kind=c_char), target, allocatable :: c_str(:)
35 integer(c_intptr_t) :: bytes_written
36 integer :: i, str_len
37
38 str_len = len_trim(str)
39 allocate(c_str(str_len + 1))
40
41 ! Convert to C string
42 do i = 1, str_len
43 c_str(i) = str(i:i)
44 end do
45 c_str(str_len + 1) = char(10) ! newline
46
47 ! Write to stdout via C FD (this respects dup2 redirections)
48 bytes_written = c_write(STDOUT_FD, c_loc(c_str), int(str_len + 1, c_size_t))
49
50 ! c_write returns -1 on error
51 success = (bytes_written >= 0)
52
53 deallocate(c_str)
54 end subroutine write_stdout_checked
55
56 ! Write string to stdout without newline (respects C FD redirections)
57 subroutine write_stdout_nonl(str)
58 character(len=*), intent(in) :: str
59 logical :: success
60 call write_stdout_nonl_checked(str, success)
61 end subroutine write_stdout_nonl
62
63 ! Write string to stdout without newline, returning success status
64 subroutine write_stdout_nonl_checked(str, success)
65 character(len=*), intent(in) :: str
66 logical, intent(out) :: success
67
68 character(kind=c_char), target, allocatable :: c_str(:)
69 integer(c_intptr_t) :: bytes_written
70 integer :: i, str_len
71
72 success = .true.
73
74 ! Use actual length, not trimmed length, to preserve trailing/leading spaces
75 str_len = len(str)
76 if (str_len == 0) return
77
78 allocate(c_str(str_len))
79
80 ! Convert to C string
81 do i = 1, str_len
82 c_str(i) = str(i:i)
83 end do
84
85 ! Write to stdout via C FD
86 bytes_written = c_write(STDOUT_FD, c_loc(c_str), int(str_len, c_size_t))
87
88 ! c_write returns -1 on error
89 success = (bytes_written >= 0)
90
91 deallocate(c_str)
92 end subroutine write_stdout_nonl_checked
93
94 ! Write string to stderr with newline (respects C FD redirections)
95 subroutine write_stderr(str)
96 character(len=*), intent(in) :: str
97
98 character(kind=c_char), target, allocatable :: c_str(:)
99 integer(c_intptr_t) :: bytes_written
100 integer :: i, str_len
101
102 str_len = len_trim(str)
103 allocate(c_str(str_len + 1))
104
105 ! Convert to C string
106 do i = 1, str_len
107 c_str(i) = str(i:i)
108 end do
109 c_str(str_len + 1) = char(10) ! newline
110
111 ! Write to stderr via C FD (this respects dup2 redirections)
112 bytes_written = c_write(STDERR_FD, c_loc(c_str), int(str_len + 1, c_size_t))
113
114 deallocate(c_str)
115 end subroutine write_stderr
116
117 end module io_helpers
118