Fortran · 14305 bytes Raw Blame History
1 ! ==============================================================================
2 ! Module: test_builtin
3 ! Purpose: Test builtin for shell conditionals ([, [[, test commands)
4 ! ==============================================================================
5 module test_builtin
6 use shell_types
7 use system_interface
8 use variables, only: is_shell_variable_set
9 use advanced_test, only: evaluate_test_expression
10 use iso_fortran_env, only: output_unit, error_unit
11 implicit none
12
13 contains
14
15 function is_test_command(cmd_name) result(is_test)
16 character(len=*), intent(in) :: cmd_name
17 logical :: is_test
18
19 is_test = (trim(cmd_name) == 'test' .or. &
20 trim(cmd_name) == '[' .or. &
21 trim(cmd_name) == '[[')
22 end function
23
24 recursive subroutine execute_test_command(cmd, shell)
25 type(command_t), intent(in) :: cmd
26 type(shell_state_t), intent(inout) :: shell
27
28 logical :: test_result
29 character(len=256) :: operator
30 character(len=256) :: left_operand, right_operand
31 logical :: left_result, right_result
32 type(command_t) :: sub_cmd, left_cmd, right_cmd
33 integer :: i, j, test_exit_status, logical_op_pos
34 integer :: paren_depth, check_pos
35 logical :: outer_parens_wrap_all
36 integer :: effective_num_tokens
37 logical :: is_bracket_cmd
38
39
40 ! Check if this is [[ ]] (advanced test) - use advanced_test module
41 if (trim(cmd%tokens(1)) == '[[') then
42 test_exit_status = evaluate_test_expression(shell, cmd%tokens, cmd%num_tokens)
43 shell%last_exit_status = test_exit_status
44 return
45 end if
46
47 ! Simple test implementation for [ and test commands
48 !
49 ! Key insight: For '[' command, the last token is always ']' which should be ignored.
50 ! We normalize by converting '[' commands to 'test' commands (stripping the ']')
51
52 if (cmd%num_tokens < 2) then
53 shell%last_exit_status = 1 ! False
54 return
55 end if
56
57 ! Determine if this is a '[' command and calculate effective token count
58 is_bracket_cmd = (trim(cmd%tokens(1)) == '[')
59 if (is_bracket_cmd) then
60 ! For '[' commands, verify the closing ']' is present
61 ! DEBUG removed
62 if (trim(cmd%tokens(cmd%num_tokens)) /= ']') then
63 write(error_unit, '(a)') '[: missing `]'''
64 shell%last_exit_status = 2 ! POSIX: syntax error returns 2
65 return
66 end if
67 ! Ignore the closing ']'
68 effective_num_tokens = cmd%num_tokens - 1
69 else
70 effective_num_tokens = cmd%num_tokens
71 end if
72
73 ! Handle different test patterns (using effective token count)
74 if (effective_num_tokens == 1) then
75 ! [ ] or just 'test' - empty test, returns false
76 test_result = .false.
77
78 else if (effective_num_tokens == 2) then
79 ! [ STRING ] or test STRING - true if STRING is not empty
80 test_result = (len_trim(cmd%tokens(2)) > 0)
81
82 else if (effective_num_tokens >= 3 .and. trim(cmd%tokens(2)) == '!') then
83 ! Logical NOT: [ ! expr ] or test ! expr
84 ! Handle this EARLY to ensure correct precedence
85 ! Recursively evaluate the rest (without the '!')
86
87 ! Create sub-command without the '!'
88 sub_cmd%num_tokens = cmd%num_tokens - 1
89 allocate(character(len=256) :: sub_cmd%tokens(sub_cmd%num_tokens))
90 sub_cmd%tokens(1) = cmd%tokens(1) ! 'test' or '['
91 do i = 2, sub_cmd%num_tokens
92 sub_cmd%tokens(i) = cmd%tokens(i+1)
93 end do
94
95 ! Recursively evaluate
96 call execute_test_command(sub_cmd, shell)
97 deallocate(sub_cmd%tokens)
98
99 ! Negate the result
100 if (shell%last_exit_status == 0) then
101 shell%last_exit_status = 1
102 else
103 shell%last_exit_status = 0
104 end if
105 return
106
107 else if (effective_num_tokens == 3) then
108 ! Unary operators: test OP ARG or [ OP ARG ]
109 operator = cmd%tokens(2)
110 right_operand = cmd%tokens(3)
111
112 select case(trim(operator))
113 ! String tests
114 case('-z')
115 test_result = (len_trim(right_operand) == 0)
116 case('-n')
117 test_result = (len_trim(right_operand) > 0)
118
119 ! File existence and type tests
120 case('-e')
121 test_result = file_exists(trim(right_operand))
122 case('-f')
123 test_result = file_is_regular(trim(right_operand))
124 case('-d')
125 test_result = file_is_directory(trim(right_operand))
126 case('-L', '-h')
127 test_result = file_is_symlink(trim(right_operand))
128 case('-b')
129 test_result = file_is_block_device(trim(right_operand))
130 case('-c')
131 test_result = file_is_char_device(trim(right_operand))
132 case('-p')
133 test_result = file_is_fifo(trim(right_operand))
134 case('-S')
135 test_result = file_is_socket(trim(right_operand))
136
137 ! Permission tests
138 case('-r')
139 test_result = file_is_readable(trim(right_operand))
140 case('-w')
141 test_result = file_is_writable(trim(right_operand))
142 case('-x')
143 test_result = file_is_executable(trim(right_operand))
144
145 ! File property tests
146 case('-s')
147 test_result = file_has_size(trim(right_operand))
148 case('-u')
149 test_result = file_has_suid(trim(right_operand))
150 case('-g')
151 test_result = file_has_sgid(trim(right_operand))
152 case('-k')
153 test_result = file_has_sticky(trim(right_operand))
154 case('-O')
155 test_result = file_owned_by_euid(trim(right_operand))
156 case('-G')
157 test_result = file_owned_by_egid(trim(right_operand))
158
159 ! Variable test
160 case('-v')
161 test_result = is_shell_variable_set(shell, trim(right_operand))
162
163 case default
164 test_result = .false.
165 end select
166
167 else if (effective_num_tokens == 4) then
168 ! Check for parentheses: [ ( expr ) ]
169 if ((trim(cmd%tokens(2)) == '(' .or. trim(cmd%tokens(2)) == '\(') .and. &
170 (trim(cmd%tokens(4)) == ')' .or. trim(cmd%tokens(4)) == '\)')) then
171 ! Parenthesized single expression - evaluate the inner expression
172 ! tokens(3) is the inner expression
173 test_result = (len_trim(cmd%tokens(3)) > 0)
174 ! Check if this is a logical operator expression (a -a b or a -o b)
175 ! These should be handled specially, not as binary comparisons
176 else if (trim(cmd%tokens(3)) == '-a' .or. trim(cmd%tokens(3)) == '-o') then
177 ! Logical operator with simple operands: [ a -a b ] or [ a -o b ]
178 ! Left side: implicit non-empty test on tokens(2)
179 left_result = (len_trim(cmd%tokens(2)) > 0)
180 ! Right side: implicit non-empty test on tokens(4)
181 right_result = (len_trim(cmd%tokens(4)) > 0)
182
183 if (trim(cmd%tokens(3)) == '-a') then
184 test_result = left_result .and. right_result
185 else ! -o
186 test_result = left_result .or. right_result
187 end if
188 else
189 ! test ARG1 OP ARG2 - binary operators
190 left_operand = cmd%tokens(2)
191 operator = cmd%tokens(3)
192 right_operand = cmd%tokens(4)
193
194 select case(trim(operator))
195 ! String comparisons
196 case('=', '==')
197 test_result = (trim(left_operand) == trim(right_operand))
198 case('!=')
199 test_result = (trim(left_operand) /= trim(right_operand))
200 case('<')
201 test_result = (trim(left_operand) < trim(right_operand))
202 case('>')
203 test_result = (trim(left_operand) > trim(right_operand))
204
205 ! Integer comparisons
206 case('-eq')
207 test_result = string_to_int(left_operand) == string_to_int(right_operand)
208 case('-ne')
209 test_result = string_to_int(left_operand) /= string_to_int(right_operand)
210 case('-lt')
211 test_result = string_to_int(left_operand) < string_to_int(right_operand)
212 case('-le')
213 test_result = string_to_int(left_operand) <= string_to_int(right_operand)
214 case('-gt')
215 test_result = string_to_int(left_operand) > string_to_int(right_operand)
216 case('-ge')
217 test_result = string_to_int(left_operand) >= string_to_int(right_operand)
218
219 ! File comparisons
220 case('-nt')
221 test_result = file_is_newer(trim(left_operand), trim(right_operand))
222 case('-ot')
223 test_result = file_is_older(trim(left_operand), trim(right_operand))
224 case('-ef')
225 test_result = file_same_as(trim(left_operand), trim(right_operand))
226
227 case default
228 test_result = .false.
229 end select
230 end if ! End of logical operator check
231
232 else if (effective_num_tokens >= 5) then
233 ! Complex expressions: parentheses and logical operators
234 ! First, check if the entire expression is wrapped in parentheses
235 ! If so, strip them and re-evaluate
236 if (trim(cmd%tokens(2)) == '\(' .or. trim(cmd%tokens(2)) == '(') then
237 ! Check if this opening paren has its matching closing paren at the end
238 ! by counting paren depth
239 paren_depth = 1
240 outer_parens_wrap_all = .false.
241
242 ! Check up to the last effective content position
243 ! For [ ( 1 -eq 1 ) ]: tokens are [, (, 1, -eq, 1, ), ]
244 ! - num_tokens = 7, effective_num_tokens = 6
245 ! - Content is positions 2-6, closing ) should be at position 6 = effective_num_tokens
246 ! For test ( 1 -eq 1 ): tokens are test, (, 1, -eq, 1, )
247 ! - num_tokens = 6, effective_num_tokens = 6
248 ! - Content is positions 2-6, closing ) should be at position 6 = effective_num_tokens
249 do check_pos = 3, effective_num_tokens
250 if (trim(cmd%tokens(check_pos)) == '\(' .or. trim(cmd%tokens(check_pos)) == '(') then
251 paren_depth = paren_depth + 1
252 else if (trim(cmd%tokens(check_pos)) == '\)' .or. trim(cmd%tokens(check_pos)) == ')') then
253 paren_depth = paren_depth - 1
254 if (paren_depth == 0) then
255 ! The opening paren at position 2 closes here
256 ! It wraps everything if this closing paren is at the last effective position
257 outer_parens_wrap_all = (check_pos == effective_num_tokens)
258 ! Exit the loop - we found where the opening paren closes
259 exit
260 end if
261 end if
262 end do
263
264 if (outer_parens_wrap_all) then
265 ! Strip outer parentheses and recursively evaluate
266 sub_cmd = cmd ! Copy all fields
267 sub_cmd%tokens(1) = cmd%tokens(1) ! Keep the original command (test or [)
268 if (is_bracket_cmd) then
269 ! For [ ], we remove ( and ) but keep [ and ]
270 ! Original: [ ( expr ) ] -> New: [ expr ]
271 sub_cmd%num_tokens = cmd%num_tokens - 2
272 do i = 2, sub_cmd%num_tokens - 1
273 sub_cmd%tokens(i) = cmd%tokens(i + 1)
274 end do
275 sub_cmd%tokens(sub_cmd%num_tokens) = ']' ! Keep closing bracket
276 else
277 ! For test, just remove ( and )
278 sub_cmd%num_tokens = cmd%num_tokens - 2
279 do i = 2, sub_cmd%num_tokens
280 sub_cmd%tokens(i) = cmd%tokens(i + 1)
281 end do
282 end if
283 call execute_test_command(sub_cmd, shell)
284 return
285 end if
286 end if
287
288 ! Check for logical operators -a (AND) or -o (OR)
289 ! Search for the LOWEST precedence operator OUTSIDE parentheses
290 ! POSIX: -o (OR) has lower precedence than -a (AND)
291 ! So we prefer -o as the split point, and skip operators inside parens
292
293 logical_op_pos = 0
294 paren_depth = 0
295 do i = 2, effective_num_tokens
296 if (trim(cmd%tokens(i)) == '\(' .or. trim(cmd%tokens(i)) == '(') then
297 paren_depth = paren_depth + 1
298 else if (trim(cmd%tokens(i)) == '\)' .or. trim(cmd%tokens(i)) == ')') then
299 paren_depth = paren_depth - 1
300 else if (paren_depth == 0) then
301 ! Only consider operators outside parentheses
302 if (trim(cmd%tokens(i)) == '-o') then
303 ! -o has lowest precedence, always use it as split point
304 logical_op_pos = i
305 exit ! Found -o, use it immediately
306 else if (trim(cmd%tokens(i)) == '-a') then
307 ! -a has higher precedence, record but keep looking for -o
308 if (logical_op_pos == 0) then
309 logical_op_pos = i
310 end if
311 end if
312 end if
313 end do
314
315 if (logical_op_pos > 0) then
316 ! Found a logical operator - split and recursively evaluate
317 ! Use 'test' for sub-commands to avoid dealing with closing ']'
318
319 ! Initialize left sub-command: tokens from 2 to logical_op_pos-1
320 left_cmd = cmd ! Copy all fields first
321 left_cmd%tokens(1) = 'test'
322 left_cmd%num_tokens = logical_op_pos - 1
323 do j = 2, left_cmd%num_tokens
324 left_cmd%tokens(j) = cmd%tokens(j)
325 end do
326
327 ! Initialize right sub-command: tokens from logical_op_pos+1 to effective end
328 ! Use effective_num_tokens to exclude the closing ']' for [ commands
329 right_cmd = cmd ! Copy all fields first
330 right_cmd%tokens(1) = 'test'
331 right_cmd%num_tokens = effective_num_tokens + 1 - logical_op_pos
332 do j = 2, right_cmd%num_tokens
333 right_cmd%tokens(j) = cmd%tokens(j + logical_op_pos - 1)
334 end do
335
336 ! Recursively evaluate left side
337 call execute_test_command(left_cmd, shell)
338 left_result = (shell%last_exit_status == 0)
339
340 ! Recursively evaluate right side
341 call execute_test_command(right_cmd, shell)
342 right_result = (shell%last_exit_status == 0)
343
344 ! Combine results with logical operator
345 if (trim(cmd%tokens(logical_op_pos)) == '-a') then
346 test_result = left_result .and. right_result
347 else ! -o
348 test_result = left_result .or. right_result
349 end if
350 else
351 ! No logical operator found - unknown pattern
352 test_result = .false.
353 end if
354
355 else
356 ! More complex expressions - simplified for now
357 test_result = .false.
358 end if
359
360 ! Set exit status based on test result
361 if (test_result) then
362 shell%last_exit_status = 0 ! True
363 else
364 shell%last_exit_status = 1 ! False
365 end if
366 end subroutine
367
368 function string_to_int(str) result(int_val)
369 character(len=*), intent(in) :: str
370 integer :: int_val
371 integer :: iostat
372
373 read(str, *, iostat=iostat) int_val
374 if (iostat /= 0) int_val = 0
375 end function
376
377 end module test_builtin