@@ -51,12 +51,63 @@ contains |
| 51 | 51 | |
| 52 | 52 | value = '' |
| 53 | 53 | |
| 54 | + ! Handle special variables first |
| 55 | + select case (trim(name)) |
| 56 | + case ('$') |
| 57 | + write(value, '(i0)') shell%shell_pid |
| 58 | + return |
| 59 | + case ('!') |
| 60 | + write(value, '(i0)') shell%last_bg_pid |
| 61 | + return |
| 62 | + case ('?') |
| 63 | + write(value, '(i0)') shell%last_exit_status |
| 64 | + return |
| 65 | + case ('0') |
| 66 | + value = trim(shell%shell_name) |
| 67 | + return |
| 68 | + case ('PPID') |
| 69 | + write(value, '(i0)') shell%parent_pid |
| 70 | + return |
| 71 | + case ('#') |
| 72 | + ! Number of positional parameters |
| 73 | + write(value, '(i0)') shell%num_positional |
| 74 | + return |
| 75 | + case ('*') |
| 76 | + ! All positional parameters as single word (IFS separated) |
| 77 | + call get_all_positional_params(shell, value, .true.) |
| 78 | + return |
| 79 | + case ('@') |
| 80 | + ! All positional parameters as separate words |
| 81 | + call get_all_positional_params(shell, value, .false.) |
| 82 | + return |
| 83 | + case ('IFS') |
| 84 | + ! Internal field separator |
| 85 | + value = trim(shell%ifs) |
| 86 | + return |
| 87 | + end select |
| 88 | + |
| 89 | + ! Handle numeric positional parameters ($1, $2, ..., $n) |
| 90 | + if (is_numeric(trim(name))) then |
| 91 | + i = string_to_int(trim(name)) |
| 92 | + if (i >= 1 .and. i <= shell%num_positional) then |
| 93 | + value = trim(shell%positional_params(i)) |
| 94 | + return |
| 95 | + else |
| 96 | + value = '' |
| 97 | + return |
| 98 | + end if |
| 99 | + end if |
| 100 | + |
| 101 | + ! Handle regular shell variables |
| 54 | 102 | do i = 1, shell%num_variables |
| 55 | 103 | if (trim(shell%variables(i)%name) == trim(name)) then |
| 56 | 104 | value = shell%variables(i)%value |
| 57 | 105 | return |
| 58 | 106 | end if |
| 59 | 107 | end do |
| 108 | + |
| 109 | + ! Handle environment variables if not found in shell variables |
| 110 | + value = get_environment_var(trim(name)) |
| 60 | 111 | end function |
| 61 | 112 | |
| 62 | 113 | function is_assignment(input_line) result(is_assign) |
@@ -80,23 +131,88 @@ contains |
| 80 | 131 | var_name = input_line(:eq_pos-1) |
| 81 | 132 | var_value = input_line(eq_pos+1:) |
| 82 | 133 | |
| 83 | | - ! Simple variable expansion during assignment |
| 84 | | - call simple_expand_variables(var_value, expanded_value, shell) |
| 85 | | - call set_shell_variable(shell, trim(var_name), expanded_value) |
| 134 | + ! Check for array assignment: var=(value1 value2 value3) |
| 135 | + if (len_trim(var_value) > 2 .and. var_value(1:1) == '(' .and. & |
| 136 | + var_value(len_trim(var_value):len_trim(var_value)) == ')') then |
| 137 | + call handle_array_assignment(shell, trim(var_name), var_value) |
| 138 | + else |
| 139 | + ! Simple variable expansion during assignment |
| 140 | + call simple_expand_variables(var_value, expanded_value, shell) |
| 141 | + call set_shell_variable(shell, trim(var_name), expanded_value) |
| 142 | + end if |
| 86 | 143 | shell%last_exit_status = 0 |
| 87 | 144 | else |
| 88 | 145 | shell%last_exit_status = 1 |
| 89 | 146 | end if |
| 90 | 147 | end subroutine |
| 91 | 148 | |
| 149 | + subroutine handle_array_assignment(shell, var_name, array_expr) |
| 150 | + type(shell_state_t), intent(inout) :: shell |
| 151 | + character(len=*), intent(in) :: var_name, array_expr |
| 152 | + character(len=1024) :: values(100) |
| 153 | + integer :: count, i, start_pos, pos |
| 154 | + character(len=1024) :: content |
| 155 | + logical :: in_quotes |
| 156 | + |
| 157 | + ! Remove parentheses |
| 158 | + content = array_expr(2:len_trim(array_expr)-1) |
| 159 | + |
| 160 | + count = 0 |
| 161 | + pos = 1 |
| 162 | + start_pos = 1 |
| 163 | + in_quotes = .false. |
| 164 | + |
| 165 | + ! Parse space-separated values, respecting quotes |
| 166 | + do while (pos <= len_trim(content)) |
| 167 | + if (content(pos:pos) == '"' .or. content(pos:pos) == "'") then |
| 168 | + in_quotes = .not. in_quotes |
| 169 | + else if (content(pos:pos) == ' ' .and. .not. in_quotes) then |
| 170 | + if (pos > start_pos) then |
| 171 | + count = count + 1 |
| 172 | + if (count <= 100) then |
| 173 | + values(count) = content(start_pos:pos-1) |
| 174 | + ! Remove quotes if present |
| 175 | + if (len_trim(values(count)) >= 2) then |
| 176 | + if ((values(count)(1:1) == '"' .and. values(count)(len_trim(values(count)):len_trim(values(count))) == '"') .or. & |
| 177 | + (values(count)(1:1) == "'" .and. values(count)(len_trim(values(count)):len_trim(values(count))) == "'")) then |
| 178 | + values(count) = values(count)(2:len_trim(values(count))-1) |
| 179 | + end if |
| 180 | + end if |
| 181 | + end if |
| 182 | + end if |
| 183 | + start_pos = pos + 1 |
| 184 | + end if |
| 185 | + pos = pos + 1 |
| 186 | + end do |
| 187 | + |
| 188 | + ! Handle last value |
| 189 | + if (start_pos <= len_trim(content)) then |
| 190 | + count = count + 1 |
| 191 | + if (count <= 100) then |
| 192 | + values(count) = content(start_pos:) |
| 193 | + ! Remove quotes if present |
| 194 | + if (len_trim(values(count)) >= 2) then |
| 195 | + if ((values(count)(1:1) == '"' .and. values(count)(len_trim(values(count)):len_trim(values(count))) == '"') .or. & |
| 196 | + (values(count)(1:1) == "'" .and. values(count)(len_trim(values(count)):len_trim(values(count))) == "'")) then |
| 197 | + values(count) = values(count)(2:len_trim(values(count))-1) |
| 198 | + end if |
| 199 | + end if |
| 200 | + end if |
| 201 | + end if |
| 202 | + |
| 203 | + if (count > 0) then |
| 204 | + call set_array_variable(shell, var_name, values, count) |
| 205 | + end if |
| 206 | + end subroutine |
| 207 | + |
| 92 | 208 | subroutine simple_expand_variables(input, expanded, shell) |
| 93 | 209 | character(len=*), intent(in) :: input |
| 94 | 210 | character(len=:), allocatable, intent(out) :: expanded |
| 95 | 211 | type(shell_state_t), intent(in) :: shell |
| 96 | 212 | |
| 97 | | - character(len=1024) :: result |
| 98 | | - integer :: i, j, var_start |
| 99 | | - character(len=256) :: var_name |
| 213 | + character(len=2048) :: result |
| 214 | + integer :: i, j, var_start, brace_end |
| 215 | + character(len=256) :: var_name, expansion_result |
| 100 | 216 | character(len=1024) :: var_value |
| 101 | 217 | character(len=:), allocatable :: env_value |
| 102 | 218 | |
@@ -107,27 +223,49 @@ contains |
| 107 | 223 | do while (i <= len_trim(input)) |
| 108 | 224 | if (input(i:i) == '$' .and. i < len_trim(input)) then |
| 109 | 225 | i = i + 1 |
| 110 | | - var_start = i |
| 111 | 226 | |
| 112 | | - ! Extract variable name |
| 113 | | - do while (i <= len_trim(input)) |
| 114 | | - if (.not. (is_alnum(input(i:i)) .or. input(i:i) == '_')) exit |
| 227 | + ! Handle ${parameter} expansions |
| 228 | + if (i <= len_trim(input) .and. input(i:i) == '{') then |
| 115 | 229 | i = i + 1 |
| 116 | | - end do |
| 117 | | - |
| 118 | | - var_name = input(var_start:i-1) |
| 119 | | - |
| 120 | | - ! Check shell variables first |
| 121 | | - var_value = get_shell_variable(shell, trim(var_name)) |
| 122 | | - if (len_trim(var_value) > 0) then |
| 123 | | - result(j:j+len_trim(var_value)-1) = trim(var_value) |
| 124 | | - j = j + len_trim(var_value) |
| 230 | + brace_end = index(input(i:), '}') |
| 231 | + if (brace_end > 0) then |
| 232 | + brace_end = brace_end + i - 1 |
| 233 | + call expand_parameter(input(i:brace_end-1), expansion_result, shell) |
| 234 | + if (len_trim(expansion_result) > 0) then |
| 235 | + result(j:j+len_trim(expansion_result)-1) = trim(expansion_result) |
| 236 | + j = j + len_trim(expansion_result) |
| 237 | + end if |
| 238 | + i = brace_end + 1 |
| 239 | + else |
| 240 | + ! Malformed ${, treat as literal |
| 241 | + result(j:j) = '$' |
| 242 | + result(j+1:j+1) = '{' |
| 243 | + j = j + 2 |
| 244 | + end if |
| 125 | 245 | else |
| 126 | | - ! Fall back to environment variables |
| 127 | | - env_value = get_environment_var(trim(var_name)) |
| 128 | | - if (allocated(env_value) .and. len(env_value) > 0) then |
| 129 | | - result(j:j+len(env_value)-1) = env_value |
| 130 | | - j = j + len(env_value) |
| 246 | + ! Handle simple $variable expansions |
| 247 | + var_start = i |
| 248 | + |
| 249 | + ! Extract variable name |
| 250 | + do while (i <= len_trim(input)) |
| 251 | + if (.not. (is_alnum(input(i:i)) .or. input(i:i) == '_')) exit |
| 252 | + i = i + 1 |
| 253 | + end do |
| 254 | + |
| 255 | + var_name = input(var_start:i-1) |
| 256 | + |
| 257 | + ! Check shell variables first |
| 258 | + var_value = get_shell_variable(shell, trim(var_name)) |
| 259 | + if (len_trim(var_value) > 0) then |
| 260 | + result(j:j+len_trim(var_value)-1) = trim(var_value) |
| 261 | + j = j + len_trim(var_value) |
| 262 | + else |
| 263 | + ! Fall back to environment variables |
| 264 | + env_value = get_environment_var(trim(var_name)) |
| 265 | + if (allocated(env_value) .and. len(env_value) > 0) then |
| 266 | + result(j:j+len(env_value)-1) = env_value |
| 267 | + j = j + len(env_value) |
| 268 | + end if |
| 131 | 269 | end if |
| 132 | 270 | end if |
| 133 | 271 | else |
@@ -149,4 +287,688 @@ contains |
| 149 | 287 | end function |
| 150 | 288 | end subroutine |
| 151 | 289 | |
| 290 | + subroutine add_function(shell, name, body_lines, body_count) |
| 291 | + type(shell_state_t), intent(inout) :: shell |
| 292 | + character(len=*), intent(in) :: name |
| 293 | + character(len=*), intent(in) :: body_lines(:) |
| 294 | + integer, intent(in) :: body_count |
| 295 | + integer :: i, j |
| 296 | + |
| 297 | + ! Find empty slot or replace existing function |
| 298 | + do i = 1, size(shell%functions) |
| 299 | + if (trim(shell%functions(i)%name) == trim(name) .or. len_trim(shell%functions(i)%name) == 0) then |
| 300 | + shell%functions(i)%name = name |
| 301 | + shell%functions(i)%body_lines = body_count |
| 302 | + |
| 303 | + if (allocated(shell%functions(i)%body)) deallocate(shell%functions(i)%body) |
| 304 | + allocate(shell%functions(i)%body(body_count)) |
| 305 | + |
| 306 | + do j = 1, body_count |
| 307 | + shell%functions(i)%body(j) = body_lines(j) |
| 308 | + end do |
| 309 | + |
| 310 | + shell%num_functions = max(shell%num_functions, i) |
| 311 | + return |
| 312 | + end if |
| 313 | + end do |
| 314 | + end subroutine |
| 315 | + |
| 316 | + function is_function(shell, name) result(found) |
| 317 | + type(shell_state_t), intent(in) :: shell |
| 318 | + character(len=*), intent(in) :: name |
| 319 | + logical :: found |
| 320 | + integer :: i |
| 321 | + |
| 322 | + found = .false. |
| 323 | + do i = 1, shell%num_functions |
| 324 | + if (trim(shell%functions(i)%name) == trim(name)) then |
| 325 | + found = .true. |
| 326 | + return |
| 327 | + end if |
| 328 | + end do |
| 329 | + end function |
| 330 | + |
| 331 | + function get_function_body(shell, name) result(body) |
| 332 | + type(shell_state_t), intent(in) :: shell |
| 333 | + character(len=*), intent(in) :: name |
| 334 | + character(len=1024), allocatable :: body(:) |
| 335 | + integer :: i |
| 336 | + |
| 337 | + do i = 1, shell%num_functions |
| 338 | + if (trim(shell%functions(i)%name) == trim(name)) then |
| 339 | + if (allocated(shell%functions(i)%body)) then |
| 340 | + allocate(body(shell%functions(i)%body_lines)) |
| 341 | + body = shell%functions(i)%body(1:shell%functions(i)%body_lines) |
| 342 | + end if |
| 343 | + return |
| 344 | + end if |
| 345 | + end do |
| 346 | + end function |
| 347 | + |
| 348 | + ! Array variable functions |
| 349 | + subroutine set_array_variable(shell, name, values, count) |
| 350 | + type(shell_state_t), intent(inout) :: shell |
| 351 | + character(len=*), intent(in) :: name |
| 352 | + character(len=*), intent(in) :: values(:) |
| 353 | + integer, intent(in) :: count |
| 354 | + integer :: i, empty_slot |
| 355 | + |
| 356 | + empty_slot = -1 |
| 357 | + |
| 358 | + ! Check if variable already exists |
| 359 | + do i = 1, shell%num_variables |
| 360 | + if (trim(shell%variables(i)%name) == trim(name)) then |
| 361 | + if (allocated(shell%variables(i)%array_values)) deallocate(shell%variables(i)%array_values) |
| 362 | + allocate(shell%variables(i)%array_values(count)) |
| 363 | + shell%variables(i)%array_values(1:count) = values(1:count) |
| 364 | + shell%variables(i)%array_size = count |
| 365 | + shell%variables(i)%is_array = .true. |
| 366 | + return |
| 367 | + end if |
| 368 | + end do |
| 369 | + |
| 370 | + ! Find empty slot |
| 371 | + do i = 1, size(shell%variables) |
| 372 | + if (shell%variables(i)%name(1:1) == char(0) .or. trim(shell%variables(i)%name) == '') then |
| 373 | + empty_slot = i |
| 374 | + exit |
| 375 | + end if |
| 376 | + end do |
| 377 | + |
| 378 | + ! Add new array variable |
| 379 | + if (empty_slot > 0) then |
| 380 | + shell%variables(empty_slot)%name = name |
| 381 | + shell%variables(empty_slot)%is_array = .true. |
| 382 | + shell%variables(empty_slot)%array_size = count |
| 383 | + if (allocated(shell%variables(empty_slot)%array_values)) deallocate(shell%variables(empty_slot)%array_values) |
| 384 | + allocate(shell%variables(empty_slot)%array_values(count)) |
| 385 | + shell%variables(empty_slot)%array_values(1:count) = values(1:count) |
| 386 | + shell%num_variables = shell%num_variables + 1 |
| 387 | + end if |
| 388 | + end subroutine |
| 389 | + |
| 390 | + function get_array_element(shell, name, index) result(value) |
| 391 | + type(shell_state_t), intent(in) :: shell |
| 392 | + character(len=*), intent(in) :: name |
| 393 | + integer, intent(in) :: index |
| 394 | + character(len=1024) :: value |
| 395 | + integer :: i |
| 396 | + |
| 397 | + value = '' |
| 398 | + |
| 399 | + do i = 1, shell%num_variables |
| 400 | + if (trim(shell%variables(i)%name) == trim(name) .and. shell%variables(i)%is_array) then |
| 401 | + if (index >= 1 .and. index <= shell%variables(i)%array_size) then |
| 402 | + value = shell%variables(i)%array_values(index) |
| 403 | + end if |
| 404 | + return |
| 405 | + end if |
| 406 | + end do |
| 407 | + end function |
| 408 | + |
| 409 | + function get_array_all_elements(shell, name) result(result_str) |
| 410 | + type(shell_state_t), intent(in) :: shell |
| 411 | + character(len=*), intent(in) :: name |
| 412 | + character(len=4096) :: result_str |
| 413 | + integer :: i, j |
| 414 | + |
| 415 | + result_str = '' |
| 416 | + |
| 417 | + do i = 1, shell%num_variables |
| 418 | + if (trim(shell%variables(i)%name) == trim(name) .and. shell%variables(i)%is_array) then |
| 419 | + do j = 1, shell%variables(i)%array_size |
| 420 | + if (j > 1) result_str = trim(result_str) // ' ' |
| 421 | + result_str = trim(result_str) // trim(shell%variables(i)%array_values(j)) |
| 422 | + end do |
| 423 | + return |
| 424 | + end if |
| 425 | + end do |
| 426 | + end function |
| 427 | + |
| 428 | + function get_array_size(shell, name) result(size) |
| 429 | + type(shell_state_t), intent(in) :: shell |
| 430 | + character(len=*), intent(in) :: name |
| 431 | + integer :: size |
| 432 | + integer :: i |
| 433 | + |
| 434 | + size = 0 |
| 435 | + |
| 436 | + do i = 1, shell%num_variables |
| 437 | + if (trim(shell%variables(i)%name) == trim(name) .and. shell%variables(i)%is_array) then |
| 438 | + size = shell%variables(i)%array_size |
| 439 | + return |
| 440 | + end if |
| 441 | + end do |
| 442 | + end function |
| 443 | + |
| 444 | + subroutine declare_associative_array(shell, name) |
| 445 | + type(shell_state_t), intent(inout) :: shell |
| 446 | + character(len=*), intent(in) :: name |
| 447 | + |
| 448 | + integer :: i, empty_slot |
| 449 | + |
| 450 | + empty_slot = -1 |
| 451 | + |
| 452 | + ! Check if variable already exists |
| 453 | + do i = 1, shell%num_variables |
| 454 | + if (trim(shell%variables(i)%name) == trim(name)) then |
| 455 | + ! Convert to associative array |
| 456 | + shell%variables(i)%is_assoc_array = .true. |
| 457 | + shell%variables(i)%is_array = .false. |
| 458 | + if (.not. allocated(shell%variables(i)%assoc_entries)) then |
| 459 | + allocate(shell%variables(i)%assoc_entries(50)) ! Initial size |
| 460 | + end if |
| 461 | + shell%variables(i)%assoc_size = 0 |
| 462 | + return |
| 463 | + end if |
| 464 | + end do |
| 465 | + |
| 466 | + ! Find empty slot |
| 467 | + do i = 1, size(shell%variables) |
| 468 | + if (shell%variables(i)%name(1:1) == char(0) .or. trim(shell%variables(i)%name) == '') then |
| 469 | + empty_slot = i |
| 470 | + exit |
| 471 | + end if |
| 472 | + end do |
| 473 | + |
| 474 | + ! Add new associative array variable |
| 475 | + if (empty_slot > 0) then |
| 476 | + shell%variables(empty_slot)%name = name |
| 477 | + shell%variables(empty_slot)%value = '' |
| 478 | + shell%variables(empty_slot)%is_assoc_array = .true. |
| 479 | + shell%variables(empty_slot)%is_array = .false. |
| 480 | + allocate(shell%variables(empty_slot)%assoc_entries(50)) |
| 481 | + shell%variables(empty_slot)%assoc_size = 0 |
| 482 | + shell%num_variables = shell%num_variables + 1 |
| 483 | + else |
| 484 | + write(error_unit, '(a)') 'declare: too many variables defined' |
| 485 | + end if |
| 486 | + end subroutine |
| 487 | + |
| 488 | + subroutine set_assoc_array_value(shell, array_name, key, value) |
| 489 | + type(shell_state_t), intent(inout) :: shell |
| 490 | + character(len=*), intent(in) :: array_name, key, value |
| 491 | + |
| 492 | + integer :: i, j |
| 493 | + |
| 494 | + ! Find the associative array variable |
| 495 | + do i = 1, shell%num_variables |
| 496 | + if (trim(shell%variables(i)%name) == trim(array_name) .and. & |
| 497 | + shell%variables(i)%is_assoc_array) then |
| 498 | + |
| 499 | + ! Check if key already exists |
| 500 | + do j = 1, shell%variables(i)%assoc_size |
| 501 | + if (trim(shell%variables(i)%assoc_entries(j)%key) == trim(key)) then |
| 502 | + shell%variables(i)%assoc_entries(j)%value = value |
| 503 | + return |
| 504 | + end if |
| 505 | + end do |
| 506 | + |
| 507 | + ! Add new key-value pair |
| 508 | + if (shell%variables(i)%assoc_size < size(shell%variables(i)%assoc_entries)) then |
| 509 | + shell%variables(i)%assoc_size = shell%variables(i)%assoc_size + 1 |
| 510 | + shell%variables(i)%assoc_entries(shell%variables(i)%assoc_size)%key = key |
| 511 | + shell%variables(i)%assoc_entries(shell%variables(i)%assoc_size)%value = value |
| 512 | + else |
| 513 | + write(error_unit, '(a)') 'associative array: too many entries' |
| 514 | + end if |
| 515 | + return |
| 516 | + end if |
| 517 | + end do |
| 518 | + |
| 519 | + write(error_unit, '(a)') 'associative array: ' // trim(array_name) // ' not declared' |
| 520 | + end subroutine |
| 521 | + |
| 522 | + function get_assoc_array_value(shell, array_name, key) result(value) |
| 523 | + type(shell_state_t), intent(in) :: shell |
| 524 | + character(len=*), intent(in) :: array_name, key |
| 525 | + character(len=1024) :: value |
| 526 | + |
| 527 | + integer :: i, j |
| 528 | + |
| 529 | + value = '' |
| 530 | + |
| 531 | + ! Find the associative array variable |
| 532 | + do i = 1, shell%num_variables |
| 533 | + if (trim(shell%variables(i)%name) == trim(array_name) .and. & |
| 534 | + shell%variables(i)%is_assoc_array) then |
| 535 | + |
| 536 | + ! Find the key |
| 537 | + do j = 1, shell%variables(i)%assoc_size |
| 538 | + if (trim(shell%variables(i)%assoc_entries(j)%key) == trim(key)) then |
| 539 | + value = shell%variables(i)%assoc_entries(j)%value |
| 540 | + return |
| 541 | + end if |
| 542 | + end do |
| 543 | + return ! Key not found, return empty string |
| 544 | + end if |
| 545 | + end do |
| 546 | + end function |
| 547 | + |
| 548 | + subroutine get_assoc_array_keys(shell, array_name, keys, num_keys) |
| 549 | + type(shell_state_t), intent(in) :: shell |
| 550 | + character(len=*), intent(in) :: array_name |
| 551 | + character(len=256), intent(out) :: keys(:) |
| 552 | + integer, intent(out) :: num_keys |
| 553 | + |
| 554 | + integer :: i, j |
| 555 | + |
| 556 | + num_keys = 0 |
| 557 | + |
| 558 | + ! Find the associative array variable |
| 559 | + do i = 1, shell%num_variables |
| 560 | + if (trim(shell%variables(i)%name) == trim(array_name) .and. & |
| 561 | + shell%variables(i)%is_assoc_array) then |
| 562 | + |
| 563 | + num_keys = min(shell%variables(i)%assoc_size, size(keys)) |
| 564 | + do j = 1, num_keys |
| 565 | + keys(j) = shell%variables(i)%assoc_entries(j)%key |
| 566 | + end do |
| 567 | + return |
| 568 | + end if |
| 569 | + end do |
| 570 | + end subroutine |
| 571 | + |
| 572 | + function is_associative_array(shell, name) result(is_assoc) |
| 573 | + type(shell_state_t), intent(in) :: shell |
| 574 | + character(len=*), intent(in) :: name |
| 575 | + logical :: is_assoc |
| 576 | + |
| 577 | + integer :: i |
| 578 | + |
| 579 | + is_assoc = .false. |
| 580 | + do i = 1, shell%num_variables |
| 581 | + if (trim(shell%variables(i)%name) == trim(name)) then |
| 582 | + is_assoc = shell%variables(i)%is_assoc_array |
| 583 | + return |
| 584 | + end if |
| 585 | + end do |
| 586 | + end function |
| 587 | + |
| 588 | + ! POSIX parameter expansion implementation |
| 589 | + subroutine expand_parameter(param_expr, result, shell) |
| 590 | + character(len=*), intent(in) :: param_expr |
| 591 | + character(len=*), intent(out) :: result |
| 592 | + type(shell_state_t), intent(in) :: shell |
| 593 | + |
| 594 | + character(len=256) :: param_name, default_value, var_value |
| 595 | + integer :: colon_pos, dash_pos, plus_pos, eq_pos, question_pos |
| 596 | + integer :: percent_pos, hash_pos, percent2_pos, hash2_pos |
| 597 | + logical :: has_colon |
| 598 | + |
| 599 | + result = '' |
| 600 | + |
| 601 | + ! Check for various POSIX parameter expansion forms |
| 602 | + colon_pos = index(param_expr, ':') |
| 603 | + has_colon = colon_pos > 0 |
| 604 | + |
| 605 | + ! ${parameter:-word} or ${parameter-word} |
| 606 | + if (has_colon) then |
| 607 | + dash_pos = index(param_expr(colon_pos:), '-') |
| 608 | + if (dash_pos > 0) then |
| 609 | + dash_pos = dash_pos + colon_pos - 1 |
| 610 | + param_name = param_expr(:colon_pos-1) |
| 611 | + default_value = param_expr(dash_pos+1:) |
| 612 | + end if |
| 613 | + else |
| 614 | + dash_pos = index(param_expr, '-') |
| 615 | + if (dash_pos > 0) then |
| 616 | + param_name = param_expr(:dash_pos-1) |
| 617 | + default_value = param_expr(dash_pos+1:) |
| 618 | + end if |
| 619 | + end if |
| 620 | + |
| 621 | + if (dash_pos > 0) then |
| 622 | + var_value = get_shell_variable(shell, trim(param_name)) |
| 623 | + if (has_colon) then |
| 624 | + ! ${parameter:-word} - use default if unset or null |
| 625 | + if (len_trim(var_value) == 0) then |
| 626 | + result = trim(default_value) |
| 627 | + else |
| 628 | + result = trim(var_value) |
| 629 | + end if |
| 630 | + else |
| 631 | + ! ${parameter-word} - use default if unset only |
| 632 | + if (len_trim(var_value) == 0 .and. .not. variable_exists(shell, trim(param_name))) then |
| 633 | + result = trim(default_value) |
| 634 | + else |
| 635 | + result = trim(var_value) |
| 636 | + end if |
| 637 | + end if |
| 638 | + return |
| 639 | + end if |
| 640 | + |
| 641 | + ! ${parameter:=word} or ${parameter=word} |
| 642 | + if (has_colon) then |
| 643 | + eq_pos = index(param_expr(colon_pos:), '=') |
| 644 | + if (eq_pos > 0) then |
| 645 | + eq_pos = eq_pos + colon_pos - 1 |
| 646 | + param_name = param_expr(:colon_pos-1) |
| 647 | + default_value = param_expr(eq_pos+1:) |
| 648 | + end if |
| 649 | + else |
| 650 | + eq_pos = index(param_expr, '=') |
| 651 | + if (eq_pos > 0) then |
| 652 | + param_name = param_expr(:eq_pos-1) |
| 653 | + default_value = param_expr(eq_pos+1:) |
| 654 | + end if |
| 655 | + end if |
| 656 | + |
| 657 | + if (eq_pos > 0) then |
| 658 | + var_value = get_shell_variable(shell, trim(param_name)) |
| 659 | + if (has_colon) then |
| 660 | + ! ${parameter:=word} - assign default if unset or null |
| 661 | + if (len_trim(var_value) == 0) then |
| 662 | + ! TODO: Need to modify shell state to assign variable |
| 663 | + result = trim(default_value) |
| 664 | + else |
| 665 | + result = trim(var_value) |
| 666 | + end if |
| 667 | + else |
| 668 | + ! ${parameter=word} - assign default if unset only |
| 669 | + if (len_trim(var_value) == 0 .and. .not. variable_exists(shell, trim(param_name))) then |
| 670 | + ! TODO: Need to modify shell state to assign variable |
| 671 | + result = trim(default_value) |
| 672 | + else |
| 673 | + result = trim(var_value) |
| 674 | + end if |
| 675 | + end if |
| 676 | + return |
| 677 | + end if |
| 678 | + |
| 679 | + ! ${parameter:?word} or ${parameter?word} |
| 680 | + if (has_colon) then |
| 681 | + question_pos = index(param_expr(colon_pos:), '?') |
| 682 | + if (question_pos > 0) then |
| 683 | + question_pos = question_pos + colon_pos - 1 |
| 684 | + param_name = param_expr(:colon_pos-1) |
| 685 | + default_value = param_expr(question_pos+1:) |
| 686 | + end if |
| 687 | + else |
| 688 | + question_pos = index(param_expr, '?') |
| 689 | + if (question_pos > 0) then |
| 690 | + param_name = param_expr(:question_pos-1) |
| 691 | + default_value = param_expr(question_pos+1:) |
| 692 | + end if |
| 693 | + end if |
| 694 | + |
| 695 | + if (question_pos > 0) then |
| 696 | + var_value = get_shell_variable(shell, trim(param_name)) |
| 697 | + if (has_colon) then |
| 698 | + ! ${parameter:?word} - error if unset or null |
| 699 | + if (len_trim(var_value) == 0) then |
| 700 | + ! TODO: Should write error and exit |
| 701 | + result = trim(param_name) // ': ' // trim(default_value) |
| 702 | + else |
| 703 | + result = trim(var_value) |
| 704 | + end if |
| 705 | + else |
| 706 | + ! ${parameter?word} - error if unset only |
| 707 | + if (len_trim(var_value) == 0 .and. .not. variable_exists(shell, trim(param_name))) then |
| 708 | + ! TODO: Should write error and exit |
| 709 | + result = trim(param_name) // ': ' // trim(default_value) |
| 710 | + else |
| 711 | + result = trim(var_value) |
| 712 | + end if |
| 713 | + end if |
| 714 | + return |
| 715 | + end if |
| 716 | + |
| 717 | + ! ${parameter:+word} or ${parameter+word} |
| 718 | + if (has_colon) then |
| 719 | + plus_pos = index(param_expr(colon_pos:), '+') |
| 720 | + if (plus_pos > 0) then |
| 721 | + plus_pos = plus_pos + colon_pos - 1 |
| 722 | + param_name = param_expr(:colon_pos-1) |
| 723 | + default_value = param_expr(plus_pos+1:) |
| 724 | + end if |
| 725 | + else |
| 726 | + plus_pos = index(param_expr, '+') |
| 727 | + if (plus_pos > 0) then |
| 728 | + param_name = param_expr(:plus_pos-1) |
| 729 | + default_value = param_expr(plus_pos+1:) |
| 730 | + end if |
| 731 | + end if |
| 732 | + |
| 733 | + if (plus_pos > 0) then |
| 734 | + var_value = get_shell_variable(shell, trim(param_name)) |
| 735 | + if (has_colon) then |
| 736 | + ! ${parameter:+word} - use word if set and not null |
| 737 | + if (len_trim(var_value) > 0) then |
| 738 | + result = trim(default_value) |
| 739 | + else |
| 740 | + result = '' |
| 741 | + end if |
| 742 | + else |
| 743 | + ! ${parameter+word} - use word if set |
| 744 | + if (variable_exists(shell, trim(param_name))) then |
| 745 | + result = trim(default_value) |
| 746 | + else |
| 747 | + result = '' |
| 748 | + end if |
| 749 | + end if |
| 750 | + return |
| 751 | + end if |
| 752 | + |
| 753 | + ! ${parameter%word} - remove smallest suffix pattern |
| 754 | + percent_pos = index(param_expr, '%', back=.true.) |
| 755 | + if (percent_pos > 0 .and. param_expr(percent_pos-1:percent_pos-1) /= '%') then |
| 756 | + param_name = param_expr(:percent_pos-1) |
| 757 | + default_value = param_expr(percent_pos+1:) |
| 758 | + var_value = get_shell_variable(shell, trim(param_name)) |
| 759 | + call remove_suffix_pattern(trim(var_value), trim(default_value), result, .false.) |
| 760 | + return |
| 761 | + end if |
| 762 | + |
| 763 | + ! ${parameter%%word} - remove largest suffix pattern |
| 764 | + percent2_pos = index(param_expr, '%%') |
| 765 | + if (percent2_pos > 0) then |
| 766 | + param_name = param_expr(:percent2_pos-1) |
| 767 | + default_value = param_expr(percent2_pos+2:) |
| 768 | + var_value = get_shell_variable(shell, trim(param_name)) |
| 769 | + call remove_suffix_pattern(trim(var_value), trim(default_value), result, .true.) |
| 770 | + return |
| 771 | + end if |
| 772 | + |
| 773 | + ! ${parameter#word} - remove smallest prefix pattern |
| 774 | + hash_pos = index(param_expr, '#') |
| 775 | + if (hash_pos > 0 .and. param_expr(hash_pos:hash_pos+1) /= '##') then |
| 776 | + param_name = param_expr(:hash_pos-1) |
| 777 | + default_value = param_expr(hash_pos+1:) |
| 778 | + var_value = get_shell_variable(shell, trim(param_name)) |
| 779 | + call remove_prefix_pattern(trim(var_value), trim(default_value), result, .false.) |
| 780 | + return |
| 781 | + end if |
| 782 | + |
| 783 | + ! ${parameter##word} - remove largest prefix pattern |
| 784 | + hash2_pos = index(param_expr, '##') |
| 785 | + if (hash2_pos > 0) then |
| 786 | + param_name = param_expr(:hash2_pos-1) |
| 787 | + default_value = param_expr(hash2_pos+2:) |
| 788 | + var_value = get_shell_variable(shell, trim(param_name)) |
| 789 | + call remove_prefix_pattern(trim(var_value), trim(default_value), result, .true.) |
| 790 | + return |
| 791 | + end if |
| 792 | + |
| 793 | + ! Simple ${parameter} expansion |
| 794 | + result = trim(get_shell_variable(shell, trim(param_expr))) |
| 795 | + end subroutine |
| 796 | + |
| 797 | + function variable_exists(shell, name) result(exists) |
| 798 | + type(shell_state_t), intent(in) :: shell |
| 799 | + character(len=*), intent(in) :: name |
| 800 | + logical :: exists |
| 801 | + integer :: i |
| 802 | + |
| 803 | + exists = .false. |
| 804 | + do i = 1, shell%num_variables |
| 805 | + if (trim(shell%variables(i)%name) == trim(name)) then |
| 806 | + exists = .true. |
| 807 | + return |
| 808 | + end if |
| 809 | + end do |
| 810 | + end function |
| 811 | + |
| 812 | + subroutine remove_suffix_pattern(value, pattern, result, largest) |
| 813 | + character(len=*), intent(in) :: value, pattern |
| 814 | + character(len=*), intent(out) :: result |
| 815 | + logical, intent(in) :: largest |
| 816 | + |
| 817 | + integer :: i, match_pos |
| 818 | + |
| 819 | + result = value |
| 820 | + match_pos = 0 |
| 821 | + |
| 822 | + ! Simple pattern matching - exact match only for now |
| 823 | + ! TODO: Add full glob pattern support |
| 824 | + if (largest) then |
| 825 | + ! Find rightmost match |
| 826 | + do i = len_trim(value), len_trim(pattern), -1 |
| 827 | + if (value(i-len_trim(pattern)+1:i) == pattern) then |
| 828 | + match_pos = i - len_trim(pattern) + 1 |
| 829 | + exit |
| 830 | + end if |
| 831 | + end do |
| 832 | + else |
| 833 | + ! Find leftmost match from the right |
| 834 | + do i = len_trim(value) - len_trim(pattern) + 1, 1, -1 |
| 835 | + if (value(i:i+len_trim(pattern)-1) == pattern) then |
| 836 | + match_pos = i |
| 837 | + end if |
| 838 | + end do |
| 839 | + end if |
| 840 | + |
| 841 | + if (match_pos > 0) then |
| 842 | + result = value(:match_pos-1) |
| 843 | + end if |
| 844 | + end subroutine |
| 845 | + |
| 846 | + subroutine remove_prefix_pattern(value, pattern, result, largest) |
| 847 | + character(len=*), intent(in) :: value, pattern |
| 848 | + character(len=*), intent(out) :: result |
| 849 | + logical, intent(in) :: largest |
| 850 | + |
| 851 | + integer :: i, match_pos, match_end |
| 852 | + |
| 853 | + result = value |
| 854 | + match_pos = 0 |
| 855 | + match_end = 0 |
| 856 | + |
| 857 | + ! Simple pattern matching - exact match only for now |
| 858 | + ! TODO: Add full glob pattern support |
| 859 | + if (largest) then |
| 860 | + ! Find rightmost match from the left |
| 861 | + do i = 1, len_trim(value) - len_trim(pattern) + 1 |
| 862 | + if (value(i:i+len_trim(pattern)-1) == pattern) then |
| 863 | + match_pos = i |
| 864 | + match_end = i + len_trim(pattern) - 1 |
| 865 | + end if |
| 866 | + end do |
| 867 | + else |
| 868 | + ! Find leftmost match |
| 869 | + do i = 1, len_trim(value) - len_trim(pattern) + 1 |
| 870 | + if (value(i:i+len_trim(pattern)-1) == pattern) then |
| 871 | + match_pos = i |
| 872 | + match_end = i + len_trim(pattern) - 1 |
| 873 | + exit |
| 874 | + end if |
| 875 | + end do |
| 876 | + end if |
| 877 | + |
| 878 | + if (match_pos > 0) then |
| 879 | + result = value(match_end+1:) |
| 880 | + end if |
| 881 | + end subroutine |
| 882 | + |
| 883 | + ! Positional parameter support functions |
| 884 | + subroutine set_positional_params(shell, params, count) |
| 885 | + type(shell_state_t), intent(inout) :: shell |
| 886 | + character(len=*), intent(in) :: params(:) |
| 887 | + integer, intent(in) :: count |
| 888 | + integer :: i, actual_count |
| 889 | + |
| 890 | + actual_count = min(count, size(shell%positional_params)) |
| 891 | + shell%num_positional = actual_count |
| 892 | + |
| 893 | + do i = 1, actual_count |
| 894 | + shell%positional_params(i) = params(i) |
| 895 | + end do |
| 896 | + |
| 897 | + ! Clear any remaining parameters |
| 898 | + do i = actual_count + 1, size(shell%positional_params) |
| 899 | + shell%positional_params(i) = '' |
| 900 | + end do |
| 901 | + end subroutine |
| 902 | + |
| 903 | + subroutine get_all_positional_params(shell, result, as_single_word) |
| 904 | + type(shell_state_t), intent(in) :: shell |
| 905 | + character(len=*), intent(out) :: result |
| 906 | + logical, intent(in) :: as_single_word |
| 907 | + integer :: i |
| 908 | + character(len=1) :: separator |
| 909 | + |
| 910 | + result = '' |
| 911 | + if (shell%num_positional == 0) return |
| 912 | + |
| 913 | + if (as_single_word) then |
| 914 | + ! Use first character of IFS as separator for $* |
| 915 | + if (len_trim(shell%ifs) > 0) then |
| 916 | + separator = shell%ifs(1:1) |
| 917 | + else |
| 918 | + separator = ' ' |
| 919 | + end if |
| 920 | + else |
| 921 | + ! Use space for $@ (will be properly quoted during expansion) |
| 922 | + separator = ' ' |
| 923 | + end if |
| 924 | + |
| 925 | + do i = 1, shell%num_positional |
| 926 | + if (i > 1) result = trim(result) // separator |
| 927 | + result = trim(result) // trim(shell%positional_params(i)) |
| 928 | + end do |
| 929 | + end subroutine |
| 930 | + |
| 931 | + subroutine shift_positional_params(shell, count) |
| 932 | + type(shell_state_t), intent(inout) :: shell |
| 933 | + integer, intent(in) :: count |
| 934 | + integer :: i, shift_count |
| 935 | + |
| 936 | + shift_count = min(count, shell%num_positional) |
| 937 | + |
| 938 | + ! Shift parameters left |
| 939 | + do i = 1, shell%num_positional - shift_count |
| 940 | + shell%positional_params(i) = shell%positional_params(i + shift_count) |
| 941 | + end do |
| 942 | + |
| 943 | + ! Clear the shifted parameters |
| 944 | + do i = shell%num_positional - shift_count + 1, shell%num_positional |
| 945 | + shell%positional_params(i) = '' |
| 946 | + end do |
| 947 | + |
| 948 | + shell%num_positional = shell%num_positional - shift_count |
| 949 | + end subroutine |
| 950 | + |
| 951 | + function is_numeric(str) result(is_num) |
| 952 | + character(len=*), intent(in) :: str |
| 953 | + logical :: is_num |
| 954 | + integer :: i |
| 955 | + |
| 956 | + is_num = .false. |
| 957 | + if (len_trim(str) == 0) return |
| 958 | + |
| 959 | + do i = 1, len_trim(str) |
| 960 | + if (str(i:i) < '0' .or. str(i:i) > '9') return |
| 961 | + end do |
| 962 | + |
| 963 | + is_num = .true. |
| 964 | + end function |
| 965 | + |
| 966 | + function string_to_int(str) result(int_val) |
| 967 | + character(len=*), intent(in) :: str |
| 968 | + integer :: int_val, iostat |
| 969 | + |
| 970 | + read(str, *, iostat=iostat) int_val |
| 971 | + if (iostat /= 0) int_val = 0 ! Error reading, return 0 |
| 972 | + end function |
| 973 | + |
| 152 | 974 | end module variables |
