fortsh Public

Watch 0 Fork 0 Star 0
Fortran · 7169 bytes Raw Blame History
1 !===============================================================================
2 ! buffer_ops.f90 - Unified buffer operations abstraction
3 !
4 ! Purpose: Provide consistent API for buffer operations that works on both
5 ! native Fortran strings (Linux) and C strings (macOS ARM64)
6 !
7 ! This module shields the readline code from platform differences.
8 !===============================================================================
9 module buffer_ops
10 #ifdef USE_C_STRINGS
11 use fortsh_c_strings
12 #endif
13 use, intrinsic :: iso_c_binding
14 implicit none
15 private
16
17 public :: buf_set_string, buf_get_string, buf_clear, buf_length
18 public :: buf_copy, buf_get_char, buf_set_char
19 public :: buf_substring, buf_append
20
21 contains
22
23 !-----------------------------------------------------------------------------
24 ! Set buffer from Fortran string
25 !-----------------------------------------------------------------------------
26 #ifdef USE_C_STRINGS
27 subroutine buf_set_string(c_buf, str)
28 type(c_string_buffer), intent(inout) :: c_buf
29 character(len=*), intent(in) :: str
30 logical :: success
31
32 success = c_string_set(c_buf, str)
33 ! Silently ignore overflow for now (matches old behavior)
34 end subroutine buf_set_string
35 #else
36 subroutine buf_set_string(fortran_buf, str)
37 character(len=:), allocatable, intent(inout) :: fortran_buf
38 character(len=*), intent(in) :: str
39
40 fortran_buf = str
41 end subroutine buf_set_string
42 #endif
43
44 !-----------------------------------------------------------------------------
45 ! Get buffer as Fortran string
46 !-----------------------------------------------------------------------------
47 #ifdef USE_C_STRINGS
48 subroutine buf_get_string(c_buf, str, actual_len)
49 type(c_string_buffer), intent(in) :: c_buf
50 character(len=*), intent(out) :: str
51 integer, intent(out), optional :: actual_len
52 integer :: len_out
53
54 call c_string_to_fortran(c_buf, str, len_out)
55 if (present(actual_len)) actual_len = len_out
56 end subroutine buf_get_string
57 #else
58 subroutine buf_get_string(fortran_buf, str, actual_len)
59 character(len=:), allocatable, intent(in) :: fortran_buf
60 character(len=*), intent(out) :: str
61 integer, intent(out), optional :: actual_len
62
63 str = fortran_buf
64 if (present(actual_len)) actual_len = len_trim(fortran_buf)
65 end subroutine buf_get_string
66 #endif
67
68 !-----------------------------------------------------------------------------
69 ! Clear buffer
70 !-----------------------------------------------------------------------------
71 #ifdef USE_C_STRINGS
72 subroutine buf_clear(c_buf)
73 type(c_string_buffer), intent(in) :: c_buf
74
75 call c_string_clear(c_buf)
76 end subroutine buf_clear
77 #else
78 subroutine buf_clear(fortran_buf)
79 character(len=:), allocatable, intent(inout) :: fortran_buf
80
81 fortran_buf = ''
82 end subroutine buf_clear
83 #endif
84
85 !-----------------------------------------------------------------------------
86 ! Get buffer length
87 !-----------------------------------------------------------------------------
88 #ifdef USE_C_STRINGS
89 function buf_length(c_buf) result(len)
90 type(c_string_buffer), intent(in) :: c_buf
91 integer :: len
92
93 len = c_string_length(c_buf)
94 end function buf_length
95 #else
96 function buf_length(fortran_buf) result(len)
97 character(len=:), allocatable, intent(in) :: fortran_buf
98 integer :: len
99
100 len = len_trim(fortran_buf)
101 end function buf_length
102 #endif
103
104 !-----------------------------------------------------------------------------
105 ! Copy buffer
106 !-----------------------------------------------------------------------------
107 #ifdef USE_C_STRINGS
108 subroutine buf_copy(dest_c, src_c)
109 type(c_string_buffer), intent(in) :: dest_c, src_c
110 logical :: success
111
112 success = c_string_copy(dest_c, src_c)
113 end subroutine buf_copy
114 #else
115 subroutine buf_copy(dest, src)
116 character(len=:), allocatable, intent(inout) :: dest
117 character(len=:), allocatable, intent(in) :: src
118
119 dest = src
120 end subroutine buf_copy
121 #endif
122
123 !-----------------------------------------------------------------------------
124 ! Get character at position (1-based)
125 !-----------------------------------------------------------------------------
126 #ifdef USE_C_STRINGS
127 function buf_get_char(c_buf, pos) result(ch)
128 type(c_string_buffer), intent(in) :: c_buf
129 integer, intent(in) :: pos
130 character(len=1) :: ch
131
132 ch = c_string_get_char(c_buf, pos)
133 end function buf_get_char
134 #else
135 function buf_get_char(fortran_buf, pos) result(ch)
136 character(len=:), allocatable, intent(in) :: fortran_buf
137 integer, intent(in) :: pos
138 character(len=1) :: ch
139
140 if (pos >= 1 .and. pos <= len(fortran_buf)) then
141 ch = fortran_buf(pos:pos)
142 else
143 ch = ' '
144 end if
145 end function buf_get_char
146 #endif
147
148 !-----------------------------------------------------------------------------
149 ! Set character at position (1-based)
150 !-----------------------------------------------------------------------------
151 #ifdef USE_C_STRINGS
152 subroutine buf_set_char(c_buf, pos, ch)
153 type(c_string_buffer), intent(in) :: c_buf
154 integer, intent(in) :: pos
155 character(len=1), intent(in) :: ch
156 logical :: success
157
158 success = c_string_set_char(c_buf, pos, ch)
159 end subroutine buf_set_char
160 #else
161 subroutine buf_set_char(fortran_buf, pos, ch)
162 character(len=:), allocatable, intent(inout) :: fortran_buf
163 integer, intent(in) :: pos
164 character(len=1), intent(in) :: ch
165
166 if (pos >= 1 .and. pos <= len(fortran_buf)) then
167 fortran_buf(pos:pos) = ch
168 end if
169 end subroutine buf_set_char
170 #endif
171
172 !-----------------------------------------------------------------------------
173 ! Extract substring
174 !-----------------------------------------------------------------------------
175 #ifdef USE_C_STRINGS
176 subroutine buf_substring(dest_c, src_c, start_pos, end_pos)
177 type(c_string_buffer), intent(in) :: dest_c, src_c
178 integer, intent(in) :: start_pos, end_pos
179 logical :: success
180
181 success = c_string_substring(dest_c, src_c, start_pos, end_pos)
182 end subroutine buf_substring
183 #else
184 subroutine buf_substring(dest, src, start_pos, end_pos)
185 character(len=:), allocatable, intent(inout) :: dest
186 character(len=:), allocatable, intent(in) :: src
187 integer, intent(in) :: start_pos, end_pos
188
189 if (start_pos >= 1 .and. end_pos <= len(src) .and. start_pos <= end_pos) then
190 dest = src(start_pos:end_pos)
191 else
192 dest = ''
193 end if
194 end subroutine buf_substring
195 #endif
196
197 !-----------------------------------------------------------------------------
198 ! Append to buffer
199 !-----------------------------------------------------------------------------
200 #ifdef USE_C_STRINGS
201 subroutine buf_append(c_buf, str)
202 type(c_string_buffer), intent(in) :: c_buf
203 character(len=*), intent(in) :: str
204 logical :: success
205
206 success = c_string_append(c_buf, str)
207 end subroutine buf_append
208 #else
209 subroutine buf_append(fortran_buf, str)
210 character(len=:), allocatable, intent(inout) :: fortran_buf
211 character(len=*), intent(in) :: str
212
213 fortran_buf = fortran_buf // str
214 end subroutine buf_append
215 #endif
216
217 end module buffer_ops
218