| 1 | ! ============================================================================== |
| 2 | ! Module: advanced_test |
| 3 | ! Purpose: Advanced test operations [[ ]] with string/file/numeric tests |
| 4 | ! ============================================================================== |
| 5 | module advanced_test |
| 6 | use shell_types |
| 7 | use system_interface |
| 8 | use variables |
| 9 | use iso_fortran_env, only: output_unit, error_unit |
| 10 | use iso_c_binding |
| 11 | implicit none |
| 12 | |
| 13 | ! Test result constants |
| 14 | integer, parameter :: TEST_TRUE = 0 |
| 15 | integer, parameter :: TEST_FALSE = 1 |
| 16 | integer, parameter :: TEST_ERROR = 2 |
| 17 | |
| 18 | ! POSIX regex types for =~ operator |
| 19 | type, bind(C) :: regex_t |
| 20 | #ifdef __APPLE__ |
| 21 | integer(c_int8_t) :: re_dummy(32) ! macOS: regex_t is 32 bytes |
| 22 | #else |
| 23 | integer(c_int8_t) :: re_dummy(256) ! Linux: regex_t is ~128-256 bytes |
| 24 | #endif |
| 25 | end type regex_t |
| 26 | |
| 27 | type, bind(C) :: regmatch_t |
| 28 | #ifdef __APPLE__ |
| 29 | integer(c_long) :: rm_so ! regoff_t is long (8 bytes) on macOS |
| 30 | integer(c_long) :: rm_eo |
| 31 | #else |
| 32 | integer(c_int) :: rm_so ! regoff_t is int (4 bytes) on Linux |
| 33 | integer(c_int) :: rm_eo |
| 34 | #endif |
| 35 | end type regmatch_t |
| 36 | |
| 37 | ! Regex compilation flags |
| 38 | integer(c_int), parameter :: REG_EXTENDED = 1 |
| 39 | integer(c_int), parameter :: REG_ICASE = 2 |
| 40 | integer(c_int), parameter :: REG_NOSUB = 4 |
| 41 | integer(c_int), parameter :: REG_NEWLINE = 8 |
| 42 | |
| 43 | ! C interface for POSIX regex |
| 44 | interface |
| 45 | function c_regcomp(preg, pattern, cflags) bind(C, name="regcomp") |
| 46 | use iso_c_binding |
| 47 | import :: regex_t |
| 48 | type(regex_t), intent(inout) :: preg |
| 49 | character(kind=c_char), dimension(*), intent(in) :: pattern |
| 50 | integer(c_int), value :: cflags |
| 51 | integer(c_int) :: c_regcomp |
| 52 | end function c_regcomp |
| 53 | |
| 54 | function c_regexec(preg, string, nmatch, pmatch, eflags) bind(C, name="regexec") |
| 55 | use iso_c_binding |
| 56 | import :: regex_t, regmatch_t |
| 57 | type(regex_t), intent(in) :: preg |
| 58 | character(kind=c_char), dimension(*), intent(in) :: string |
| 59 | integer(c_size_t), value :: nmatch |
| 60 | type(regmatch_t), dimension(*) :: pmatch |
| 61 | integer(c_int), value :: eflags |
| 62 | integer(c_int) :: c_regexec |
| 63 | end function c_regexec |
| 64 | |
| 65 | subroutine c_regfree(preg) bind(C, name="regfree") |
| 66 | use iso_c_binding |
| 67 | import :: regex_t |
| 68 | type(regex_t), intent(inout) :: preg |
| 69 | end subroutine c_regfree |
| 70 | end interface |
| 71 | |
| 72 | contains |
| 73 | |
| 74 | ! Main [[ ]] test evaluation |
| 75 | function evaluate_test_expression(shell, tokens, num_tokens) result(test_result) |
| 76 | type(shell_state_t), intent(inout) :: shell |
| 77 | character(len=*), intent(in) :: tokens(:) |
| 78 | integer, intent(in) :: num_tokens |
| 79 | integer :: test_result |
| 80 | |
| 81 | character(len=256) :: left_operand, operator, right_operand |
| 82 | logical :: result_bool |
| 83 | |
| 84 | test_result = TEST_FALSE |
| 85 | |
| 86 | if (num_tokens < 3) then |
| 87 | test_result = TEST_ERROR |
| 88 | return |
| 89 | end if |
| 90 | |
| 91 | ! Skip [[ and ]] tokens |
| 92 | if (num_tokens == 3) then |
| 93 | ! Single condition: [[ condition ]] |
| 94 | result_bool = evaluate_unary_test(shell, tokens(2)) |
| 95 | else if (num_tokens == 5) then |
| 96 | ! Binary condition: [[ left op right ]] |
| 97 | left_operand = tokens(2) |
| 98 | operator = tokens(3) |
| 99 | right_operand = tokens(4) |
| 100 | result_bool = evaluate_binary_test(shell, left_operand, operator, right_operand) |
| 101 | else |
| 102 | ! Complex expression with logical operators |
| 103 | result_bool = evaluate_complex_test(shell, tokens, num_tokens) |
| 104 | end if |
| 105 | |
| 106 | if (result_bool) then |
| 107 | test_result = TEST_TRUE |
| 108 | else |
| 109 | test_result = TEST_FALSE |
| 110 | end if |
| 111 | end function |
| 112 | |
| 113 | ! Evaluate unary test conditions |
| 114 | function evaluate_unary_test(shell, operand) result(result_bool) |
| 115 | type(shell_state_t), intent(in) :: shell |
| 116 | character(len=*), intent(in) :: operand |
| 117 | logical :: result_bool |
| 118 | |
| 119 | character(len=256) :: expanded_operand |
| 120 | |
| 121 | result_bool = .false. |
| 122 | |
| 123 | ! Expand variables in operand |
| 124 | call expand_test_operand(shell, operand, expanded_operand) |
| 125 | |
| 126 | ! Non-empty string test |
| 127 | result_bool = (len_trim(expanded_operand) > 0) |
| 128 | end function |
| 129 | |
| 130 | ! Evaluate binary test conditions |
| 131 | function evaluate_binary_test(shell, left, operator, right) result(result_bool) |
| 132 | type(shell_state_t), intent(inout) :: shell |
| 133 | character(len=*), intent(in) :: left, operator, right |
| 134 | logical :: result_bool |
| 135 | |
| 136 | character(len=256) :: expanded_left, expanded_right |
| 137 | |
| 138 | result_bool = .false. |
| 139 | |
| 140 | ! Expand variables in operands |
| 141 | call expand_test_operand(shell, left, expanded_left) |
| 142 | call expand_test_operand(shell, right, expanded_right) |
| 143 | |
| 144 | select case (trim(operator)) |
| 145 | ! String comparisons (use wildcard match for [[ ]] glob support) |
| 146 | case ('=', '==') |
| 147 | result_bool = wildcard_match(trim(expanded_left), trim(expanded_right)) |
| 148 | case ('!=') |
| 149 | result_bool = (trim(expanded_left) /= trim(expanded_right)) |
| 150 | case ('<') |
| 151 | result_bool = (trim(expanded_left) < trim(expanded_right)) |
| 152 | case ('>') |
| 153 | result_bool = (trim(expanded_left) > trim(expanded_right)) |
| 154 | case ('=~') |
| 155 | result_bool = match_regex(shell, expanded_left, expanded_right) |
| 156 | case ('!~') |
| 157 | result_bool = .not. match_regex(shell, expanded_left, expanded_right) |
| 158 | |
| 159 | ! Numeric comparisons |
| 160 | case ('-eq') |
| 161 | result_bool = numeric_equal(expanded_left, expanded_right) |
| 162 | case ('-ne') |
| 163 | result_bool = .not. numeric_equal(expanded_left, expanded_right) |
| 164 | case ('-lt') |
| 165 | result_bool = numeric_less_than(expanded_left, expanded_right) |
| 166 | case ('-le') |
| 167 | result_bool = numeric_less_equal(expanded_left, expanded_right) |
| 168 | case ('-gt') |
| 169 | result_bool = numeric_greater_than(expanded_left, expanded_right) |
| 170 | case ('-ge') |
| 171 | result_bool = numeric_greater_equal(expanded_left, expanded_right) |
| 172 | |
| 173 | ! File tests |
| 174 | case ('-ef') |
| 175 | result_bool = files_same_device_inode(expanded_left, expanded_right) |
| 176 | case ('-nt') |
| 177 | result_bool = file_newer_than(expanded_left, expanded_right) |
| 178 | case ('-ot') |
| 179 | result_bool = file_older_than(expanded_left, expanded_right) |
| 180 | |
| 181 | case default |
| 182 | result_bool = .false. |
| 183 | end select |
| 184 | end function |
| 185 | |
| 186 | ! Evaluate complex expressions with && || ! operators |
| 187 | function evaluate_complex_test(shell, tokens, num_tokens) result(result_bool) |
| 188 | type(shell_state_t), intent(inout) :: shell |
| 189 | character(len=*), intent(in) :: tokens(:) |
| 190 | integer, intent(in) :: num_tokens |
| 191 | logical :: result_bool |
| 192 | |
| 193 | integer :: i |
| 194 | logical :: current_result, next_result |
| 195 | character(len=16) :: logical_op |
| 196 | |
| 197 | result_bool = .false. |
| 198 | current_result = .false. |
| 199 | logical_op = '' |
| 200 | |
| 201 | ! Simple left-to-right evaluation |
| 202 | i = 2 ! Skip initial [[ |
| 203 | |
| 204 | do while (i < num_tokens) |
| 205 | if (tokens(i) == '&&' .or. tokens(i) == '||' .or. tokens(i) == '!') then |
| 206 | logical_op = tokens(i) |
| 207 | i = i + 1 |
| 208 | else if (tokens(i) == ']]') then |
| 209 | exit |
| 210 | else |
| 211 | ! Evaluate next test |
| 212 | if (i + 2 < num_tokens .and. is_test_operator(tokens(i+1))) then |
| 213 | ! Binary test |
| 214 | next_result = evaluate_binary_test(shell, tokens(i), tokens(i+1), tokens(i+2)) |
| 215 | i = i + 3 |
| 216 | ! After a binary test, next token must be logical operator or ]] |
| 217 | ! Extra tokens are a syntax error (e.g., [[ x =~ foo bar ]] is invalid) |
| 218 | if (i < num_tokens) then |
| 219 | if (tokens(i) /= '&&' .and. tokens(i) /= '||' .and. tokens(i) /= ']]') then |
| 220 | ! Syntax error: unexpected token after binary test |
| 221 | result_bool = .false. |
| 222 | return |
| 223 | end if |
| 224 | end if |
| 225 | else if (is_unary_test_operator(tokens(i)) .and. & |
| 226 | i + 1 < num_tokens) then |
| 227 | ! Unary operator with argument: -z str, -n str, -e file, etc. |
| 228 | block |
| 229 | character(len=256) :: expanded_arg |
| 230 | call expand_test_operand(shell, tokens(i+1), expanded_arg) |
| 231 | select case (trim(tokens(i))) |
| 232 | case ('-z') |
| 233 | next_result = (len_trim(expanded_arg) == 0) |
| 234 | case ('-n') |
| 235 | next_result = (len_trim(expanded_arg) > 0) |
| 236 | case ('-e', '-f', '-d', '-r', '-w', '-x', '-s', '-L', & |
| 237 | '-h', '-p', '-b', '-c', '-g', '-u', '-k', '-G', & |
| 238 | '-O', '-S') |
| 239 | next_result = file_test(expanded_arg, tokens(i)) |
| 240 | case default |
| 241 | next_result = .false. |
| 242 | end select |
| 243 | end block |
| 244 | i = i + 2 |
| 245 | else |
| 246 | ! Simple unary test (non-empty string check) |
| 247 | next_result = evaluate_unary_test(shell, tokens(i)) |
| 248 | i = i + 1 |
| 249 | end if |
| 250 | |
| 251 | ! Apply logical operator |
| 252 | select case (trim(logical_op)) |
| 253 | case ('&&') |
| 254 | current_result = current_result .and. next_result |
| 255 | case ('||') |
| 256 | current_result = current_result .or. next_result |
| 257 | case ('!') |
| 258 | current_result = .not. next_result |
| 259 | case ('') |
| 260 | current_result = next_result |
| 261 | end select |
| 262 | |
| 263 | logical_op = '' |
| 264 | end if |
| 265 | end do |
| 266 | |
| 267 | result_bool = current_result |
| 268 | end function |
| 269 | |
| 270 | ! File test operations |
| 271 | function file_test(filename, test_type) result(test_result) |
| 272 | character(len=*), intent(in) :: filename, test_type |
| 273 | logical :: test_result |
| 274 | |
| 275 | logical :: exists, is_file, is_dir, is_executable, is_readable, is_writable |
| 276 | |
| 277 | test_result = .false. |
| 278 | |
| 279 | ! Check file existence and properties |
| 280 | inquire(file=trim(filename), exist=exists) |
| 281 | |
| 282 | if (.not. exists) then |
| 283 | test_result = .false. |
| 284 | return |
| 285 | end if |
| 286 | |
| 287 | ! Use stat-like functionality through system calls |
| 288 | call get_file_info(filename, exists, is_file, is_dir, is_executable, is_readable, is_writable) |
| 289 | |
| 290 | select case (trim(test_type)) |
| 291 | case ('-e') ! exists |
| 292 | test_result = exists |
| 293 | case ('-f') ! regular file |
| 294 | test_result = is_file |
| 295 | case ('-d') ! directory |
| 296 | test_result = is_dir |
| 297 | case ('-r') ! readable |
| 298 | test_result = is_readable |
| 299 | case ('-w') ! writable |
| 300 | test_result = is_writable |
| 301 | case ('-x') ! executable |
| 302 | test_result = is_executable |
| 303 | case ('-s') ! non-empty |
| 304 | test_result = (file_size(filename) > 0) |
| 305 | case ('-L', '-h') ! symbolic link |
| 306 | test_result = is_symbolic_link(filename) |
| 307 | case ('-b') ! block device |
| 308 | test_result = is_block_device(filename) |
| 309 | case ('-c') ! character device |
| 310 | test_result = is_char_device(filename) |
| 311 | case ('-p') ! named pipe |
| 312 | test_result = is_named_pipe(filename) |
| 313 | case ('-S') ! socket |
| 314 | test_result = is_socket(filename) |
| 315 | case default |
| 316 | test_result = .false. |
| 317 | end select |
| 318 | end function |
| 319 | |
| 320 | ! String pattern matching with POSIX regex |
| 321 | function match_regex(shell, string, pattern) result(matches) |
| 322 | type(shell_state_t), intent(inout) :: shell |
| 323 | character(len=*), intent(in) :: string, pattern |
| 324 | logical :: matches |
| 325 | |
| 326 | type(regex_t) :: regex |
| 327 | type(regmatch_t) :: pmatch(10) ! Capture up to 9 groups + full match |
| 328 | character(kind=c_char, len=:), allocatable :: c_pattern, c_string |
| 329 | integer(c_int) :: comp_result, exec_result |
| 330 | integer :: match_idx, match_start, match_end |
| 331 | character(len=256) :: matched_str |
| 332 | |
| 333 | matches = .false. |
| 334 | |
| 335 | ! Prepare C strings (null-terminated) |
| 336 | c_pattern = trim(pattern) // c_null_char |
| 337 | c_string = trim(string) // c_null_char |
| 338 | |
| 339 | ! Compile the regex pattern (use extended regex, add case-insensitive flag if nocasematch is enabled) |
| 340 | if (shell%shopt_nocasematch) then |
| 341 | comp_result = c_regcomp(regex, c_pattern, ior(REG_EXTENDED, REG_ICASE)) |
| 342 | else |
| 343 | comp_result = c_regcomp(regex, c_pattern, REG_EXTENDED) |
| 344 | end if |
| 345 | |
| 346 | if (comp_result == 0) then |
| 347 | ! Pattern compiled successfully - now execute it with capture groups |
| 348 | exec_result = c_regexec(regex, c_string, 10_c_size_t, pmatch, 0_c_int) |
| 349 | |
| 350 | if (exec_result == 0) then |
| 351 | ! Match found - populate BASH_REMATCH array |
| 352 | matches = .true. |
| 353 | |
| 354 | ! Populate captured groups |
| 355 | do match_idx = 0, 9 |
| 356 | ! Check if this match is valid (rm_so != -1) |
| 357 | if (pmatch(match_idx + 1)%rm_so /= -1) then |
| 358 | match_start = pmatch(match_idx + 1)%rm_so + 1 ! Convert to 1-based |
| 359 | match_end = pmatch(match_idx + 1)%rm_eo |
| 360 | |
| 361 | ! Extract matched substring |
| 362 | matched_str = '' |
| 363 | if (match_end > match_start - 1) then |
| 364 | matched_str = string(match_start:match_end) |
| 365 | end if |
| 366 | |
| 367 | ! Store in BASH_REMATCH[match_idx] (use 1-based index for Fortran) |
| 368 | call set_array_element(shell, 'BASH_REMATCH', match_idx + 1, trim(matched_str)) |
| 369 | else |
| 370 | ! No more matches |
| 371 | exit |
| 372 | end if |
| 373 | end do |
| 374 | end if |
| 375 | |
| 376 | ! Clean up regex |
| 377 | call c_regfree(regex) |
| 378 | end if |
| 379 | end function |
| 380 | |
| 381 | recursive function wildcard_match(string, pattern) result(matches) |
| 382 | character(len=*), intent(in) :: string, pattern |
| 383 | logical :: matches |
| 384 | |
| 385 | integer :: s_pos, p_pos, s_len, p_len |
| 386 | |
| 387 | matches = .false. |
| 388 | s_len = len_trim(string) |
| 389 | p_len = len_trim(pattern) |
| 390 | s_pos = 1 |
| 391 | p_pos = 1 |
| 392 | |
| 393 | do while (s_pos <= s_len .and. p_pos <= p_len) |
| 394 | if (pattern(p_pos:p_pos) == '*') then |
| 395 | ! Skip consecutive * |
| 396 | do while (p_pos <= p_len .and. pattern(p_pos:p_pos) == '*') |
| 397 | p_pos = p_pos + 1 |
| 398 | end do |
| 399 | |
| 400 | if (p_pos > p_len) then |
| 401 | matches = .true. |
| 402 | return |
| 403 | end if |
| 404 | |
| 405 | ! Try to match remaining pattern |
| 406 | do while (s_pos <= s_len) |
| 407 | if (wildcard_match(string(s_pos:), pattern(p_pos:))) then |
| 408 | matches = .true. |
| 409 | return |
| 410 | end if |
| 411 | s_pos = s_pos + 1 |
| 412 | end do |
| 413 | |
| 414 | return |
| 415 | else if (pattern(p_pos:p_pos) == '?' .or. pattern(p_pos:p_pos) == string(s_pos:s_pos)) then |
| 416 | p_pos = p_pos + 1 |
| 417 | s_pos = s_pos + 1 |
| 418 | else |
| 419 | return |
| 420 | end if |
| 421 | end do |
| 422 | |
| 423 | ! Handle trailing * |
| 424 | do while (p_pos <= p_len .and. pattern(p_pos:p_pos) == '*') |
| 425 | p_pos = p_pos + 1 |
| 426 | end do |
| 427 | |
| 428 | matches = (s_pos > s_len .and. p_pos > p_len) |
| 429 | end function |
| 430 | |
| 431 | ! Numeric comparison functions |
| 432 | function numeric_equal(left, right) result(equal) |
| 433 | character(len=*), intent(in) :: left, right |
| 434 | logical :: equal |
| 435 | integer :: left_val, right_val, status1, status2 |
| 436 | |
| 437 | read(left, *, iostat=status1) left_val |
| 438 | read(right, *, iostat=status2) right_val |
| 439 | |
| 440 | if (status1 == 0 .and. status2 == 0) then |
| 441 | equal = (left_val == right_val) |
| 442 | else |
| 443 | equal = .false. |
| 444 | end if |
| 445 | end function |
| 446 | |
| 447 | function numeric_less_than(left, right) result(less) |
| 448 | character(len=*), intent(in) :: left, right |
| 449 | logical :: less |
| 450 | integer :: left_val, right_val, status1, status2 |
| 451 | |
| 452 | read(left, *, iostat=status1) left_val |
| 453 | read(right, *, iostat=status2) right_val |
| 454 | |
| 455 | if (status1 == 0 .and. status2 == 0) then |
| 456 | less = (left_val < right_val) |
| 457 | else |
| 458 | less = .false. |
| 459 | end if |
| 460 | end function |
| 461 | |
| 462 | function numeric_less_equal(left, right) result(less_eq) |
| 463 | character(len=*), intent(in) :: left, right |
| 464 | logical :: less_eq |
| 465 | integer :: left_val, right_val, status1, status2 |
| 466 | |
| 467 | read(left, *, iostat=status1) left_val |
| 468 | read(right, *, iostat=status2) right_val |
| 469 | |
| 470 | if (status1 == 0 .and. status2 == 0) then |
| 471 | less_eq = (left_val <= right_val) |
| 472 | else |
| 473 | less_eq = .false. |
| 474 | end if |
| 475 | end function |
| 476 | |
| 477 | function numeric_greater_than(left, right) result(greater) |
| 478 | character(len=*), intent(in) :: left, right |
| 479 | logical :: greater |
| 480 | integer :: left_val, right_val, status1, status2 |
| 481 | |
| 482 | read(left, *, iostat=status1) left_val |
| 483 | read(right, *, iostat=status2) right_val |
| 484 | |
| 485 | if (status1 == 0 .and. status2 == 0) then |
| 486 | greater = (left_val > right_val) |
| 487 | else |
| 488 | greater = .false. |
| 489 | end if |
| 490 | end function |
| 491 | |
| 492 | function numeric_greater_equal(left, right) result(greater_eq) |
| 493 | character(len=*), intent(in) :: left, right |
| 494 | logical :: greater_eq |
| 495 | integer :: left_val, right_val, status1, status2 |
| 496 | |
| 497 | read(left, *, iostat=status1) left_val |
| 498 | read(right, *, iostat=status2) right_val |
| 499 | |
| 500 | if (status1 == 0 .and. status2 == 0) then |
| 501 | greater_eq = (left_val >= right_val) |
| 502 | else |
| 503 | greater_eq = .false. |
| 504 | end if |
| 505 | end function |
| 506 | |
| 507 | ! File comparison functions (simplified implementations) |
| 508 | function files_same_device_inode(file1, file2) result(same) |
| 509 | character(len=*), intent(in) :: file1, file2 |
| 510 | logical :: same |
| 511 | |
| 512 | ! Simplified: compare paths |
| 513 | same = (trim(file1) == trim(file2)) |
| 514 | end function |
| 515 | |
| 516 | function file_newer_than(file1, file2) result(newer) |
| 517 | character(len=*), intent(in) :: file1, file2 |
| 518 | logical :: newer |
| 519 | |
| 520 | ! Placeholder implementation |
| 521 | newer = .false. |
| 522 | if (.false.) print *, file1, file2 ! Silence unused warnings |
| 523 | end function |
| 524 | |
| 525 | function file_older_than(file1, file2) result(older) |
| 526 | character(len=*), intent(in) :: file1, file2 |
| 527 | logical :: older |
| 528 | |
| 529 | ! Placeholder implementation |
| 530 | older = .false. |
| 531 | if (.false.) print *, file1, file2 ! Silence unused warnings |
| 532 | end function |
| 533 | |
| 534 | function file_size(filename) result(size) |
| 535 | character(len=*), intent(in) :: filename |
| 536 | integer :: size |
| 537 | |
| 538 | integer :: unit, iostat |
| 539 | character :: dummy |
| 540 | |
| 541 | size = 0 |
| 542 | |
| 543 | open(newunit=unit, file=trim(filename), status='old', iostat=iostat) |
| 544 | if (iostat == 0) then |
| 545 | do |
| 546 | read(unit, '(A1)', iostat=iostat) dummy |
| 547 | if (iostat /= 0) exit |
| 548 | size = size + 1 |
| 549 | end do |
| 550 | close(unit) |
| 551 | end if |
| 552 | end function |
| 553 | |
| 554 | ! File type checking (simplified implementations) |
| 555 | function is_symbolic_link(filename) result(is_link) |
| 556 | character(len=*), intent(in) :: filename |
| 557 | logical :: is_link |
| 558 | |
| 559 | is_link = .false. ! Placeholder |
| 560 | if (.false.) print *, filename ! Silence unused warning |
| 561 | end function |
| 562 | |
| 563 | function is_block_device(filename) result(is_block) |
| 564 | character(len=*), intent(in) :: filename |
| 565 | logical :: is_block |
| 566 | |
| 567 | is_block = .false. ! Placeholder |
| 568 | if (.false.) print *, filename ! Silence unused warning |
| 569 | end function |
| 570 | |
| 571 | function is_char_device(filename) result(is_char) |
| 572 | character(len=*), intent(in) :: filename |
| 573 | logical :: is_char |
| 574 | |
| 575 | is_char = .false. ! Placeholder |
| 576 | if (.false.) print *, filename ! Silence unused warning |
| 577 | end function |
| 578 | |
| 579 | function is_named_pipe(filename) result(is_pipe) |
| 580 | character(len=*), intent(in) :: filename |
| 581 | logical :: is_pipe |
| 582 | |
| 583 | is_pipe = .false. ! Placeholder |
| 584 | if (.false.) print *, filename ! Silence unused warning |
| 585 | end function |
| 586 | |
| 587 | function is_socket(filename) result(is_sock) |
| 588 | character(len=*), intent(in) :: filename |
| 589 | logical :: is_sock |
| 590 | |
| 591 | is_sock = .false. ! Placeholder |
| 592 | if (.false.) print *, filename ! Silence unused warning |
| 593 | end function |
| 594 | |
| 595 | subroutine get_file_info(filename, exists, is_file, is_dir, is_executable, is_readable, is_writable) |
| 596 | character(len=*), intent(in) :: filename |
| 597 | logical, intent(out) :: exists, is_file, is_dir, is_executable, is_readable, is_writable |
| 598 | |
| 599 | character(len=:), allocatable :: test_cmd |
| 600 | integer :: status |
| 601 | |
| 602 | ! Use system test command for file properties |
| 603 | inquire(file=trim(filename), exist=exists) |
| 604 | |
| 605 | if (exists) then |
| 606 | ! Test if it's a regular file |
| 607 | test_cmd = 'test -f ' // trim(filename) |
| 608 | call execute_command_line(test_cmd, exitstat=status) |
| 609 | is_file = (status == 0) |
| 610 | |
| 611 | ! Test if it's a directory |
| 612 | test_cmd = 'test -d ' // trim(filename) |
| 613 | call execute_command_line(test_cmd, exitstat=status) |
| 614 | is_dir = (status == 0) |
| 615 | |
| 616 | ! Test permissions |
| 617 | test_cmd = 'test -r ' // trim(filename) |
| 618 | call execute_command_line(test_cmd, exitstat=status) |
| 619 | is_readable = (status == 0) |
| 620 | |
| 621 | test_cmd = 'test -w ' // trim(filename) |
| 622 | call execute_command_line(test_cmd, exitstat=status) |
| 623 | is_writable = (status == 0) |
| 624 | |
| 625 | test_cmd = 'test -x ' // trim(filename) |
| 626 | call execute_command_line(test_cmd, exitstat=status) |
| 627 | is_executable = (status == 0) |
| 628 | else |
| 629 | is_file = .false. |
| 630 | is_dir = .false. |
| 631 | is_executable = .false. |
| 632 | is_readable = .false. |
| 633 | is_writable = .false. |
| 634 | end if |
| 635 | end subroutine |
| 636 | |
| 637 | ! Helper functions |
| 638 | function is_test_operator(op) result(is_op) |
| 639 | character(len=*), intent(in) :: op |
| 640 | logical :: is_op |
| 641 | |
| 642 | is_op = (op == '=' .or. op == '==' .or. op == '!=' .or. & |
| 643 | op == '<' .or. op == '>' .or. op == '=~' .or. op == '!~' .or. & |
| 644 | op == '-eq' .or. op == '-ne' .or. op == '-lt' .or. op == '-le' .or. & |
| 645 | op == '-gt' .or. op == '-ge' .or. op == '-ef' .or. op == '-nt' .or. & |
| 646 | op == '-ot') |
| 647 | end function |
| 648 | |
| 649 | function is_unary_test_operator(op) result(is_op) |
| 650 | character(len=*), intent(in) :: op |
| 651 | logical :: is_op |
| 652 | |
| 653 | is_op = (op == '-z' .or. op == '-n' .or. & |
| 654 | op == '-e' .or. op == '-f' .or. op == '-d' .or. & |
| 655 | op == '-r' .or. op == '-w' .or. op == '-x' .or. & |
| 656 | op == '-s' .or. op == '-L' .or. op == '-h' .or. & |
| 657 | op == '-p' .or. op == '-b' .or. op == '-c' .or. & |
| 658 | op == '-g' .or. op == '-u' .or. op == '-k' .or. & |
| 659 | op == '-G' .or. op == '-O' .or. op == '-S') |
| 660 | end function |
| 661 | |
| 662 | subroutine expand_test_operand(shell, operand, expanded) |
| 663 | type(shell_state_t), intent(in) :: shell |
| 664 | character(len=*), intent(in) :: operand |
| 665 | character(len=*), intent(out) :: expanded |
| 666 | |
| 667 | character(len=:), allocatable :: temp |
| 668 | integer :: temp_len |
| 669 | |
| 670 | ! Simple variable expansion for test operands |
| 671 | if (operand(1:1) == '$') then |
| 672 | temp = get_shell_variable(shell, operand(2:)) |
| 673 | else |
| 674 | temp = operand |
| 675 | end if |
| 676 | |
| 677 | ! Strip surrounding quotes if present |
| 678 | temp_len = len_trim(temp) |
| 679 | if (temp_len >= 2) then |
| 680 | if ((temp(1:1) == '"' .and. temp(temp_len:temp_len) == '"') .or. & |
| 681 | (temp(1:1) == "'" .and. temp(temp_len:temp_len) == "'")) then |
| 682 | expanded = temp(2:temp_len-1) |
| 683 | return |
| 684 | end if |
| 685 | end if |
| 686 | |
| 687 | expanded = temp |
| 688 | end subroutine |
| 689 | |
| 690 | end module advanced_test |