Fortran · 49062 bytes Raw Blame History
1 ! ==============================================================================
2 ! Main Program: Fortran Shell (Fortsh)
3 ! ==============================================================================
4 program fortran_shell
5 use shell_types
6 use system_interface
7 use signal_handler
8 use signal_handling
9 use parser, only: convert_backticks_to_dollar_paren, has_unclosed_quote, ends_with_continuation_backslash, &
10 needs_compound_continuation, remove_line_continuations, process_substitutions, &
11 get_heredoc_delimiter
12
13 use grammar_parser ! New grammar-aware parser
14 use ast_executor, only: execute_ast, register_trap_evaluator
15 use command_tree ! Command tree for new parser
16 use executor, only: init_completion_executor, init_control_flow_callbacks
17 use job_control
18 use readline
19 use shell_config
20 use variables, only: get_shell_variable, set_shell_variable
21 use aliases
22 use shell_options
23 use performance
24 use prompt_formatting
25 use command_capture_callback, only: init_command_capture ! For command substitution
26 use builtins, only: init_builtins ! Initialize builtin function pointers
27 use coprocess, only: init_coprocess_registry
28 use version, only: print_version, print_help
29 use iso_fortran_env, only: input_unit, output_unit, error_unit
30 use iso_c_binding, only: c_int
31 implicit none
32
33 type(shell_state_t), allocatable :: shell
34 character(len=16384) :: input_line, proc_subst_line
35 character(len=:), allocatable :: expanded_line, history_expanded
36 character(len=MAX_VAR_VALUE_LEN) :: prompt_str ! Fixed-length to avoid LLVM Flang heap corruption
37 character(len=MAX_VAR_VALUE_LEN) :: rprompt_str ! Right-side prompt (like zsh RPROMPT)
38 character(len=:), allocatable :: rprompt_value ! RPROMPT variable value
39 integer :: iostat, i, num_args
40 character(len=MAX_PATH_LEN) :: arg1, command_string
41 logical :: execute_command_string, execute_script_file, syntax_check_only
42 character(len=:), allocatable :: script_file
43 ! Command duration tracking
44 integer :: cmd_start_time, cmd_end_time, cmd_duration_ms, clock_rate
45 real :: cmd_duration_sec
46 ! New parser infrastructure
47 type(command_node_t), pointer :: ast_root
48 integer :: exit_code
49 character(len=:), allocatable :: converted_line
50 ! Terminal resize support
51 character(len=16) :: cols_str, rows_str
52 logical :: success
53 ! RPROMPT embedding for multi-line prompts
54 integer :: newline_pos, first_line_vlen, rprompt_vlen, rprompt_col
55 character(len=16) :: col_str_buf
56 character(len=2048) :: embedded_prompt
57
58 ! macOS: set S_CTTYREF on controlling terminal to prevent PTY output loss
59 ! (macOS kernel discards slave PTY buffer on child exit without this flag)
60 interface
61 subroutine fortsh_set_cttyref() bind(C, name="fortsh_set_cttyref")
62 end subroutine
63 end interface
64 call fortsh_set_cttyref()
65
66 ! Initialize performance monitoring
67 call init_performance_monitoring()
68
69 ! Silence unused function warning for convert_escape_sequences (kept for future use)
70 if (.false.) input_line = convert_escape_sequences('')
71
72 ! Allocate shell to avoid large stack allocation on macOS
73 allocate(shell)
74
75 ! Initialize these BEFORE initialize_shell since it uses them to check interactivity
76 execute_command_string = .false.
77 execute_script_file = .false.
78 syntax_check_only = .false.
79
80 ! Check for command-line arguments FIRST to detect non-interactive modes
81 num_args = command_argument_count()
82
83 ! Handle command-line arguments for script execution
84 if (num_args > 0) then
85 call get_command_argument(1, arg1)
86
87 ! Check for --version or -v flag
88 if (trim(arg1) == '--version' .or. trim(arg1) == '-v') then
89 call print_version()
90 call c_exit(0_c_int)
91 end if
92
93 ! Check for --help or -h flag
94 if (trim(arg1) == '--help' .or. trim(arg1) == '-h') then
95 call print_help()
96 call c_exit(0_c_int)
97 end if
98
99 ! Check for -n flag (syntax check only, no execution)
100 if (trim(arg1) == '-n') then
101 syntax_check_only = .true.
102 execute_script_file = .true.
103 ! If there's a script file after -n, use it
104 if (num_args >= 2) then
105 if (.not. allocated(script_file)) allocate(character(len=MAX_PATH_LEN) :: script_file)
106 call get_command_argument(2, script_file)
107 execute_script_file = .true.
108 end if
109 ! Check for -c flag (execute command string)
110 else if (trim(arg1) == '-c') then
111 if (num_args >= 2) then
112 call get_command_argument(2, command_string)
113 execute_command_string = .true.
114 ! Note: Additional arguments after command string will be processed
115 ! after shell initialization (to set $0 and positional params)
116 else
117 write(error_unit, '(a)') 'fortsh: -c: option requires an argument'
118 stop 2
119 end if
120 ! Check if it's not a flag (assume it's a script file)
121 else if (arg1(1:1) /= '-') then
122 script_file = trim(arg1)
123 execute_script_file = .true.
124 end if
125 end if
126
127 ! Initialize shell (reads execute_command_string/execute_script_file to set is_interactive)
128 call initialize_shell(shell)
129
130 ! Set option_noexec if -n flag was used
131 if (syntax_check_only) then
132 shell%option_noexec = .true.
133 end if
134
135 ! Initialize builtin function pointers (breaks circular dependency)
136 call init_builtins()
137
138 ! Initialize control flow callbacks (breaks circular dependency)
139 call init_control_flow_callbacks()
140
141 ! Initialize command history (needed even in non-interactive mode)
142 call init_history()
143
144 ! Initialize signal handling module
145 call init_signal_handling(shell)
146
147 ! Register AST evaluator for trap dispatch (breaks executor<->ast_executor circular dep)
148 call register_trap_evaluator()
149
150 ! Initialize command capture callback (for command substitution)
151 call init_command_capture()
152
153 ! Initialize completion function executor callback (for -F completion)
154 call init_completion_executor()
155
156 ! Setup signal handlers if interactive
157 if (shell%is_interactive) then
158 call setup_signal_handlers()
159
160 ! Welcome message for interactive mode
161 write(output_unit, '(a)') 'Welcome to Fortran Shell (fortsh)!'
162 write(output_unit, '(a)') 'Type "help" for available commands or "exit" to quit.'
163 write(output_unit, '(a)') ''
164
165 ! Load configuration file
166 call load_config_file(shell)
167
168 ! Set HISTCONTROL for history management
169 call set_histcontrol(shell%histcontrol)
170
171 ! Check HISTFILE env var override before loading
172 block
173 character(len=:), allocatable :: histfile_env
174 histfile_env = get_environment_var('HISTFILE')
175 if (len(histfile_env) > 0) then
176 shell%histfile = histfile_env
177 end if
178 end block
179
180 ! Load command history from file (skip if /dev/null)
181 if (len_trim(shell%histfile) > 0 .and. trim(shell%histfile) /= '/dev/null') then
182 call load_history_from_file(trim(shell%histfile), shell%histsize)
183 end if
184 end if
185
186 ! Execute command string if -c was specified
187 if (execute_command_string) then
188 ! Set LINENO to 1 for -c commands (POSIX: lines start at 1)
189 shell%current_line_number = 1
190 ! Mark that we're in command mode (for $- flag)
191 shell%in_command_mode = .true.
192
193 ! POSIX: Handle additional arguments after -c 'command'
194 ! For -c 'command' arg0 arg1 arg2: arg0 becomes $0, arg1 arg2 become $1 $2
195 if (num_args >= 3) then
196 block
197 character(len=MAX_PATH_LEN) :: c_arg
198 integer :: c_idx
199 ! Third argument becomes $0
200 call get_command_argument(3, c_arg)
201 shell%shell_name = trim(c_arg)
202 ! Remaining arguments become positional parameters $1, $2, ...
203 if (num_args >= 4) then
204 shell%num_positional = num_args - 3
205 if (.not. allocated(shell%positional_params)) then
206 allocate(shell%positional_params(shell%num_positional))
207 shell%positional_params_capacity = shell%num_positional
208 else if (shell%positional_params_capacity < shell%num_positional) then
209 deallocate(shell%positional_params)
210 allocate(shell%positional_params(shell%num_positional))
211 shell%positional_params_capacity = shell%num_positional
212 end if
213 do c_idx = 4, num_args
214 call get_command_argument(c_idx, c_arg)
215 shell%positional_params(c_idx - 3)%str = trim(c_arg)
216 end do
217 end if
218 end block
219 end if
220
221 ! Check if string contains heredoc outside quotes and pre-process it
222 if (has_heredoc_outside_quotes(command_string)) then
223 ! Pre-process heredocs before parsing
224 command_string = preprocess_heredocs_for_c(command_string, shell)
225 ! write(error_unit, '(A,A)') 'DEBUG: After preprocess, command_string=', trim(command_string)
226 end if
227
228 ! Handle line continuation (backslash-newline)
229 command_string = remove_line_continuations(command_string)
230 call process_substitutions(shell, trim(command_string), proc_subst_line)
231
232 ! POSIX set -v: Print input line before execution
233 if (shell%option_verbose) then
234 write(error_unit, '(A)') trim(command_string)
235 end if
236
237 ! Parse to AST and execute
238 converted_line = convert_backticks_to_dollar_paren(proc_subst_line)
239 ast_root => parse_command_line(converted_line)
240 if (associated(ast_root)) then
241 shell%current_command = converted_line
242 exit_code = execute_ast(ast_root, shell)
243 shell%last_exit_status = exit_code
244 call destroy_command_node(ast_root)
245 ! Handle source commands that were the last/only command in -c string
246 if (shell%should_source) then
247 call process_source_file(shell)
248 end if
249 else if (last_parse_had_error) then
250 ! Parse error occurred (not just empty command)
251 shell%last_exit_status = 2
252 end if
253
254 ! Process any sourced files queued by the command
255 if (shell%should_source) then
256 call process_source_file(shell)
257 end if
258
259 ! Execute EXIT trap if one is set (before exiting)
260 call execute_trap_for_signal(shell, 0) ! 0 is TRAP_EXIT
261
262 ! Exit with last command's exit status
263 call c_exit(shell%last_exit_status)
264 end if
265
266 ! Execute script file if specified
267 if (execute_script_file) then
268 shell%source_file = script_file
269 shell%should_source = .true.
270 call process_source_file(shell)
271
272 ! Execute EXIT trap if one is set (before exiting)
273 call execute_trap_for_signal(shell, 0) ! 0 is TRAP_EXIT
274
275 ! Exit with last command's exit status (don't print Goodbye for scripts)
276 if (perf_monitoring_enabled) then
277 call print_performance_stats()
278 end if
279 call cleanup_performance_monitoring()
280 call c_exit(shell%last_exit_status)
281 end if
282
283 ! Main REPL loop
284 do while (shell%running)
285 ! Check for terminal resize (SIGWINCH)
286 if (g_terminal_resized) then
287 g_terminal_resized = .false.
288 ! Re-query terminal dimensions
289 success = get_terminal_size(shell%term_rows, shell%term_cols)
290 ! Update both environment variables (for child processes) and shell variables (for $COLUMNS/$LINES)
291 write(cols_str, '(I0)') shell%term_cols
292 write(rows_str, '(I0)') shell%term_rows
293 success = set_environment_var('COLUMNS', trim(cols_str))
294 success = set_environment_var('LINES', trim(rows_str))
295 call set_shell_variable(shell, 'COLUMNS', trim(cols_str))
296 call set_shell_variable(shell, 'LINES', trim(rows_str))
297 end if
298
299 ! Update job status
300 if (shell%is_interactive) then
301 call update_job_status(shell)
302 call notify_job_status(shell)
303 end if
304
305 ! Process sourced files
306 if (shell%should_source) then
307 call process_source_file(shell)
308 cycle
309 end if
310
311 ! Read input with enhanced readline (includes prompt only if interactive)
312 if (shell%is_interactive) then
313 ! Use safe_expand_prompt to avoid LLVM Flang heap corruption
314 call safe_expand_prompt(shell%ps1, shell, shell%ps1_len, prompt_str)
315
316 ! Get RPROMPT if set (zsh-style right prompt)
317 rprompt_value = get_shell_variable(shell, 'RPROMPT')
318 if (len_trim(rprompt_value) > 0) then
319 call safe_expand_prompt(rprompt_value, shell, len(rprompt_value), rprompt_str)
320
321 ! Check if prompt is multi-line
322 newline_pos = index(trim(prompt_str), char(10))
323 if (newline_pos > 0) then
324 ! Multi-line prompt with RPROMPT: embed RPROMPT in first line
325 first_line_vlen = visual_length(prompt_str(1:newline_pos-1))
326 rprompt_vlen = visual_length(trim(rprompt_str))
327 rprompt_col = shell%term_cols - rprompt_vlen + 1
328
329 if (rprompt_col > first_line_vlen + 4) then
330 write(col_str_buf, '(I0)') rprompt_col
331 embedded_prompt = prompt_str(1:newline_pos-1) // &
332 char(27) // '[' // trim(col_str_buf) // 'G' // &
333 trim(rprompt_str) // &
334 prompt_str(newline_pos:len_trim(prompt_str))
335 call readline_enhanced(trim(embedded_prompt), input_line, iostat, keep_raw=.true.)
336 else
337 call readline_enhanced(trim(prompt_str), input_line, iostat, keep_raw=.true.)
338 end if
339 else
340 ! Single-line prompt: pass RPROMPT to readline for its handling
341 call readline_enhanced(trim(prompt_str), input_line, iostat, trim(rprompt_str), keep_raw=.true.)
342 end if
343 else
344 call readline_enhanced(trim(prompt_str), input_line, iostat, keep_raw=.true.)
345 end if
346 else
347 read(input_unit, '(a)', iostat=iostat) input_line
348 end if
349
350 ! Check for terminal resize that may have occurred during readline
351 ! (SIGWINCH can arrive while waiting for input)
352 if (g_terminal_resized) then
353 g_terminal_resized = .false.
354 success = get_terminal_size(shell%term_rows, shell%term_cols)
355 write(cols_str, '(I0)') shell%term_cols
356 write(rows_str, '(I0)') shell%term_rows
357 success = set_environment_var('COLUMNS', trim(cols_str))
358 success = set_environment_var('LINES', trim(rows_str))
359 call set_shell_variable(shell, 'COLUMNS', trim(cols_str))
360 call set_shell_variable(shell, 'LINES', trim(rows_str))
361 end if
362
363 ! Check for EOF (Ctrl-D)
364 if (iostat /= 0) then
365 ! Only print newline in interactive mode for clean exit
366 if (shell%is_interactive) then
367 write(output_unit, '(a)') ''
368 end if
369 exit
370 end if
371
372 ! Skip empty lines
373 if (len_trim(input_line) == 0) cycle
374
375 ! Check for unclosed quotes or backslash continuation and continue reading
376 do while (has_unclosed_quote(input_line) .or. ends_with_continuation_backslash(input_line))
377 if (shell%is_interactive) then
378 prompt_str = expand_prompt(shell%ps2, shell, shell%ps2_len)
379 call readline_enhanced(prompt_str, proc_subst_line, iostat, keep_raw=.true.)
380 else
381 ! Non-interactive: just read next line
382 read(input_unit, '(a)', iostat=iostat) proc_subst_line
383 end if
384
385 ! Check for EOF during continuation
386 if (iostat /= 0) then
387 ! Only print newline in interactive mode for clean exit
388 if (shell%is_interactive) then
389 write(output_unit, '(a)') ''
390 end if
391 exit
392 end if
393
394 ! Append the continuation line with a newline character
395 input_line = trim(input_line) // char(10) // trim(proc_subst_line)
396 end do
397
398 ! Handle line continuation (backslash-newline)
399 input_line = remove_line_continuations(input_line)
400
401 ! Log: about to check compound continuation
402 ! Check for unclosed compound commands (if/fi, do/done, case/esac)
403 do while (needs_compound_continuation(input_line))
404 if (shell%is_interactive) then
405 prompt_str = expand_prompt(shell%ps2, shell, shell%ps2_len)
406 call readline_enhanced(prompt_str, proc_subst_line, iostat, keep_raw=.true.)
407 else
408 ! Non-interactive: just read next line
409 read(input_unit, '(a)', iostat=iostat) proc_subst_line
410 end if
411
412 ! Check for EOF during compound continuation
413 if (iostat /= 0) then
414 if (shell%is_interactive) then
415 write(output_unit, '(a)') ''
416 end if
417 exit
418 end if
419
420 ! Append the continuation line with a newline character
421 input_line = trim(input_line) // char(10) // trim(proc_subst_line)
422 end do
423
424 ! Pre-process heredocs in accumulated compound commands
425 ! The compound continuation loop may have collected heredoc content inline.
426 ! Extract it and store as pending so the executor doesn't try to read from stdin.
427 if (has_heredoc_outside_quotes(input_line) .and. index(input_line, char(10)) > 0) then
428 input_line = preprocess_heredocs_for_c(input_line, shell)
429 end if
430
431 ! Restore terminal from raw mode (readline keeps raw for continuation prompts)
432 if (shell%is_interactive) call restore_readline_terminal()
433
434 ! Expand history (!!, !n, !string, etc.) if needed
435 if (needs_history_expansion(input_line)) then
436 history_expanded = expand_history(input_line)
437 ! Print expanded command if interactive (like bash does)
438 if (shell%is_interactive) then
439 write(output_unit, '(a)') trim(history_expanded)
440 end if
441 ! Add the EXPANDED command to history (not the original !!)
442 call add_to_history(history_expanded)
443 ! Now expand aliases on the history-expanded line
444 call expand_alias(shell, trim(history_expanded), expanded_line)
445 else
446 ! No history expansion needed, add original line to history
447 call add_to_history(input_line)
448 ! Then expand aliases
449 call expand_alias(shell, trim(input_line), expanded_line)
450 end if
451
452 ! Process substitutions <() and >() before parsing
453 call process_substitutions(shell, expanded_line, proc_subst_line)
454
455 ! POSIX set -v: Print input line before execution
456 if (shell%option_verbose) then
457 write(error_unit, '(A)') trim(expanded_line)
458 end if
459
460 ! Parse and execute via AST
461 call system_clock(cmd_start_time, clock_rate)
462
463 converted_line = convert_backticks_to_dollar_paren(proc_subst_line)
464 ast_root => parse_command_line(converted_line)
465 if (associated(ast_root)) then
466 ! Store current command for job descriptions
467 shell%current_command = converted_line
468
469 ! POSIX: In noexec mode, parse but don't execute (ignored in interactive shells)
470 if (shell%option_noexec .and. .not. shell%is_interactive) then
471 shell%last_exit_status = 0
472 exit_code = 0
473 else
474 exit_code = execute_ast(ast_root, shell)
475 shell%last_exit_status = exit_code
476 end if
477
478 ! Flush output after command execution — flang-new buffers Fortran I/O
479 ! and won't flush to PTY until the buffer fills or process exits.
480 ! Without this, interactive output appears delayed or missing.
481 flush(output_unit)
482 flush(error_unit)
483
484 call destroy_command_node(ast_root)
485
486 ! Calculate and display duration if > 1 second
487 call system_clock(cmd_end_time)
488 cmd_duration_ms = (cmd_end_time - cmd_start_time) * 1000 / clock_rate
489 cmd_duration_sec = real(cmd_duration_ms) / 1000.0
490
491 if (shell%is_interactive .and. cmd_duration_sec >= 1.0) then
492 if (shell%term_supports_color) then
493 write(output_unit, '(a,f0.1,a)') char(27) // '[2m' // 'Executed in ', &
494 cmd_duration_sec, 's' // char(27) // '[0m'
495 else
496 write(output_unit, '(a,f0.1,a)') 'Executed in ', cmd_duration_sec, 's'
497 end if
498 end if
499
500 ! Update terminal title after command execution
501 if (shell%is_interactive .and. shell%term_supports_color) then
502 call set_terminal_title(trim(shell%username) // '@' // trim(shell%hostname) // ': ' // trim(shell%cwd))
503 end if
504
505 ! Increment command number for next prompt
506 shell%command_number = shell%command_number + 1
507 call increment_prompt_history()
508 else if (last_parse_had_error) then
509 shell%last_exit_status = 2
510 end if
511 end do
512
513 ! Execute EXIT trap if one is set
514 call execute_trap_for_signal(shell, 0) ! 0 is TRAP_EXIT
515
516 ! Save command history to file (only in interactive mode)
517 if (shell%is_interactive .and. len_trim(shell%histfile) > 0 .and. get_history_count() > 0) then
518 call save_history_to_file(trim(shell%histfile), shell%histfilesize)
519 end if
520
521 ! Run logout scripts if this is a login shell
522 if (shell%is_login_shell) then
523 call run_logout_scripts(shell)
524 end if
525
526 ! Print performance statistics if monitoring was enabled
527 if (perf_monitoring_enabled) then
528 call print_performance_stats()
529 end if
530
531 ! Cleanup performance monitoring
532 call cleanup_performance_monitoring()
533
534 ! Only print goodbye message in interactive mode
535 if (shell%is_interactive) then
536 write(output_unit, '(a)') 'Goodbye!'
537 end if
538
539 ! Exit with the last command's exit status (preserves exit code from EXIT trap)
540 call c_exit(shell%last_exit_status)
541
542 contains
543
544 ! Remove backslash-newline line continuations from input
545
546 ! Convert escape sequences like \n to actual characters for -c flag
547 function convert_escape_sequences(input) result(output)
548 character(len=*), intent(in) :: input
549 character(len=len(input)*2) :: output ! Worst case: all chars become newlines
550 integer :: i, j
551
552 output = ''
553 i = 1
554 j = 1
555
556 do while (i <= len_trim(input))
557 ! Check for backslash escape sequences
558 if (i < len_trim(input) .and. input(i:i) == '\') then
559 select case(input(i+1:i+1))
560 case('n')
561 ! Convert \n to actual newline
562 output(j:j) = char(10)
563 i = i + 2
564 j = j + 1
565 case('t')
566 ! Convert \t to tab
567 output(j:j) = char(9)
568 i = i + 2
569 j = j + 1
570 case('\')
571 ! Convert \\ to single backslash
572 output(j:j) = '\'
573 i = i + 2
574 j = j + 1
575 case default
576 ! Keep backslash and next char as-is
577 output(j:j) = input(i:i)
578 j = j + 1
579 i = i + 1
580 end select
581 else
582 ! Regular character, copy as-is
583 output(j:j) = input(i:i)
584 i = i + 1
585 j = j + 1
586 end if
587 end do
588 end function
589
590 ! Check if a string contains heredoc syntax (<<) outside of quotes
591 function has_heredoc_outside_quotes(str) result(has_heredoc)
592 character(len=*), intent(in) :: str
593 logical :: has_heredoc
594 integer :: i
595 logical :: in_single_quote, in_double_quote
596 character :: ch
597
598 has_heredoc = .false.
599 in_single_quote = .false.
600 in_double_quote = .false.
601
602 do i = 1, len_trim(str) - 1
603 ch = str(i:i)
604
605 ! Track quote state
606 if (.not. in_double_quote .and. ch == "'") then
607 in_single_quote = .not. in_single_quote
608 else if (.not. in_single_quote .and. ch == '"') then
609 in_double_quote = .not. in_double_quote
610 end if
611
612 ! Check for << when outside quotes (but NOT <<< which is here-string)
613 if (.not. in_single_quote .and. .not. in_double_quote) then
614 if (str(i:i+1) == '<<') then
615 ! Skip <<< (here-string)
616 if (i + 2 <= len_trim(str) .and. str(i+2:i+2) == '<') cycle
617 has_heredoc = .true.
618 return
619 end if
620 end if
621 end do
622 end function
623
624 ! Check if input has unclosed compound commands that need more lines
625 ! Uses the lexer to properly distinguish keywords from arguments
626
627 ! Pre-process heredocs in -c commands
628 ! Extracts heredoc content and stores it for later use
629 function preprocess_heredocs_for_c(input, shell) result(output)
630 use shell_types
631 use iso_fortran_env, only: error_unit
632 character(len=*), intent(in) :: input
633 type(shell_state_t), intent(inout) :: shell
634 character(len=len(input)*2) :: output
635 integer :: i, j, k, cmd_line_end, content_pos
636 integer :: delim_start, delim_end, content_start, content_end
637 character(len=256) :: delimiter, delimiters(MAX_PENDING_HEREDOCS)
638 logical :: quoted_delimiters(MAX_PENDING_HEREDOCS), strip_tabs_arr(MAX_PENDING_HEREDOCS)
639 integer :: num_heredocs, heredoc_idx
640 character(len=4096) :: heredoc_content
641 logical :: quoted_delimiter, strip_tabs
642 character(len=len(input)) :: cmd_line
643
644 output = input ! Start with original
645
646 ! Find the line containing << — scan all lines, not just the first
647 ! The heredoc operator may be inside a compound command (if/then/fi)
648 block
649 integer :: nl_pos, search_start, ll
650 cmd_line_end = 0
651 search_start = 1
652 do
653 nl_pos = index(input(search_start:), char(10))
654 if (nl_pos == 0) then
655 ll = len_trim(input)
656 else
657 ll = search_start + nl_pos - 2
658 end if
659 ! Check if this line contains << outside quotes
660 if (has_heredoc_outside_quotes(input(search_start:ll))) then
661 cmd_line = input(1:ll)
662 cmd_line_end = ll + 1 ! position after the line (at the newline or past end)
663 exit
664 end if
665 if (nl_pos == 0) exit
666 search_start = search_start + nl_pos
667 end do
668 end block
669 if (cmd_line_end == 0) return
670
671 ! Count and collect all heredoc delimiters from the command line
672 ! Only match << when it's outside quotes
673 num_heredocs = 0
674 i = 1
675 do while (i <= len_trim(cmd_line))
676 ! Find next << outside of quotes
677 j = 0
678 block
679 integer :: search_pos
680 logical :: in_single_quote, in_double_quote
681 character :: ch
682
683 in_single_quote = .false.
684 in_double_quote = .false.
685 search_pos = i
686
687 do while (search_pos <= len_trim(cmd_line) - 1)
688 ch = cmd_line(search_pos:search_pos)
689
690 ! Track quote state
691 if (.not. in_double_quote .and. ch == "'") then
692 in_single_quote = .not. in_single_quote
693 else if (.not. in_single_quote .and. ch == '"') then
694 in_double_quote = .not. in_double_quote
695 end if
696
697 ! Check for << when outside quotes (but NOT <<< which is here-string)
698 if (.not. in_single_quote .and. .not. in_double_quote) then
699 if (cmd_line(search_pos:search_pos+1) == '<<') then
700 ! Skip <<< (here-string)
701 if (search_pos + 2 <= len_trim(cmd_line) .and. &
702 cmd_line(search_pos+2:search_pos+2) == '<') then
703 search_pos = search_pos + 3
704 cycle
705 end if
706 j = search_pos
707 exit
708 end if
709 end if
710
711 search_pos = search_pos + 1
712 end do
713 end block
714
715 if (j == 0) exit
716
717 ! Check for <<- (strip tabs)
718 strip_tabs = .false.
719 if (j + 2 <= len_trim(cmd_line) .and. cmd_line(j+2:j+2) == '-') then
720 strip_tabs = .true.
721 k = j + 3
722 else
723 k = j + 2
724 end if
725
726 ! Skip spaces after << or <<-
727 do while (k <= len_trim(cmd_line) .and. cmd_line(k:k) == ' ')
728 k = k + 1
729 end do
730
731 if (k > len_trim(cmd_line)) exit
732
733 ! Check for quoted delimiter
734 quoted_delimiter = .false.
735 if (cmd_line(k:k) == "'" .or. cmd_line(k:k) == '"') then
736 quoted_delimiter = .true.
737 block
738 character :: quote_char
739 quote_char = cmd_line(k:k)
740 k = k + 1
741 delim_start = k
742 ! Find closing quote
743 delim_end = k
744 do while (delim_end <= len_trim(cmd_line) .and. cmd_line(delim_end:delim_end) /= quote_char)
745 delim_end = delim_end + 1
746 end do
747 delim_end = delim_end - 1
748 end block
749 else
750 delim_start = k
751 ! Find end of delimiter (space, semicolon, or end of line)
752 delim_end = k
753 do while (delim_end <= len_trim(cmd_line) .and. &
754 cmd_line(delim_end:delim_end) /= ' ' .and. &
755 cmd_line(delim_end:delim_end) /= ';')
756 delim_end = delim_end + 1
757 end do
758 delim_end = delim_end - 1
759 end if
760
761 if (delim_end >= delim_start .and. num_heredocs < MAX_PENDING_HEREDOCS) then
762 num_heredocs = num_heredocs + 1
763 delimiters(num_heredocs) = cmd_line(delim_start:delim_end)
764 quoted_delimiters(num_heredocs) = quoted_delimiter
765 strip_tabs_arr(num_heredocs) = strip_tabs
766 end if
767
768 i = delim_end + 1
769 if (quoted_delimiter) i = i + 1 ! Skip closing quote
770 end do
771
772 if (num_heredocs == 0) return
773
774 ! Now extract content for each heredoc in order
775 content_pos = cmd_line_end + 1 ! Start after the command line newline
776
777 do heredoc_idx = 1, num_heredocs
778 delimiter = trim(delimiters(heredoc_idx))
779 strip_tabs = strip_tabs_arr(heredoc_idx)
780
781 ! Find content until the delimiter
782 content_start = content_pos
783 content_end = 0
784
785 j = content_pos
786 do while (j <= len_trim(input))
787 ! Check if we're at start of a line
788 if (j == content_pos .or. input(j-1:j-1) == char(10)) then
789 ! For <<-, skip leading tabs before checking delimiter
790 k = j
791 if (strip_tabs) then
792 do while (k <= len_trim(input) .and. input(k:k) == char(9))
793 k = k + 1
794 end do
795 end if
796 ! Check if this line starts with the delimiter (after tabs if strip_tabs)
797 if (k + len_trim(delimiter) - 1 <= len_trim(input)) then
798 if (input(k:k+len_trim(delimiter)-1) == trim(delimiter)) then
799 ! Check if delimiter is alone on the line or followed by newline
800 if (k + len_trim(delimiter) > len_trim(input) .or. &
801 input(k+len_trim(delimiter):k+len_trim(delimiter)) == char(10)) then
802 content_end = j - 1
803 content_pos = k + len_trim(delimiter)
804 if (content_pos <= len_trim(input) .and. &
805 input(content_pos:content_pos) == char(10)) then
806 content_pos = content_pos + 1
807 end if
808 exit
809 end if
810 end if
811 end if
812 end if
813 j = j + 1
814 end do
815
816 ! Extract heredoc content
817 if (content_end >= content_start) then
818 heredoc_content = input(content_start:content_end)
819 else
820 heredoc_content = ''
821 end if
822
823 ! Strip leading tabs if requested
824 if (strip_tabs) then
825 block
826 integer :: m, n
827 character(len=4096) :: stripped_content
828 logical :: at_line_start
829
830 stripped_content = ''
831 m = 1
832 n = 1
833 at_line_start = .true.
834
835 do while (m <= len_trim(heredoc_content))
836 if (at_line_start .and. heredoc_content(m:m) == char(9)) then
837 ! Skip leading tab
838 m = m + 1
839 else
840 ! Copy character
841 at_line_start = .false.
842 stripped_content(n:n) = heredoc_content(m:m)
843 if (heredoc_content(m:m) == char(10)) then
844 at_line_start = .true.
845 end if
846 n = n + 1
847 m = m + 1
848 end if
849 end do
850
851 heredoc_content = stripped_content
852 end block
853 end if
854
855 ! Store in pending heredocs array
856 shell%pending_heredocs(heredoc_idx)%content = trim(heredoc_content)
857 shell%pending_heredocs(heredoc_idx)%delimiter = trim(delimiter)
858 shell%pending_heredocs(heredoc_idx)%quoted = quoted_delimiters(heredoc_idx)
859 shell%pending_heredocs(heredoc_idx)%strip_tabs = strip_tabs
860 end do
861
862 shell%num_pending_heredocs = num_heredocs
863 shell%next_pending_heredoc = 1
864
865 ! Also set legacy single heredoc for backward compatibility
866 if (num_heredocs >= 1) then
867 shell%pending_heredoc = shell%pending_heredocs(1)%content
868 shell%pending_heredoc_delimiter = shell%pending_heredocs(1)%delimiter
869 shell%pending_heredoc_quoted = shell%pending_heredocs(1)%quoted
870 shell%pending_heredoc_strip_tabs = shell%pending_heredocs(1)%strip_tabs
871 shell%has_pending_heredoc = .true.
872 end if
873
874 ! Return the command line plus any remaining commands after heredocs
875 if (content_pos <= len_trim(input)) then
876 ! There are more commands after the last heredoc
877 output = trim(cmd_line) // char(10) // trim(input(content_pos:))
878 else
879 output = cmd_line
880 end if
881
882 end function
883
884 subroutine run_logout_scripts(shell)
885 type(shell_state_t), intent(inout) :: shell
886 character(len=:), allocatable :: home_dir, logout_file
887 logical :: file_exists
888
889 home_dir = get_environment_var('HOME')
890 if (len(home_dir) == 0) return
891
892 ! Execute ~/.fortsh_logout if it exists
893 logout_file = trim(home_dir) // '/.fortsh_logout'
894 inquire(file=logout_file, exist=file_exists)
895
896 if (file_exists) then
897 ! Source the logout file
898 shell%source_file = logout_file
899 shell%should_source = .true.
900 call process_source_file(shell)
901 end if
902 end subroutine
903
904
905 recursive subroutine process_source_file(shell)
906 use grammar_parser, only: parse_command_line, last_parse_had_error
907 use command_tree, only: destroy_command_node, command_node_t
908 use ast_executor, only: execute_ast
909 type(shell_state_t), intent(inout) :: shell
910 character(len=16384) :: input_line, proc_subst_line, converted_line
911 character(len=16384) :: continuation_line
912 integer :: file_unit, iostat, exit_code
913 type(command_node_t), pointer :: ast_root
914 character(len=:), allocatable :: expanded_line, history_expanded
915
916 ! Reset the source flag first
917 shell%should_source = .false.
918
919 ! Open file for reading
920 open(newunit=file_unit, file=trim(shell%source_file), status='old', action='read', iostat=iostat)
921 if (iostat /= 0) then
922 write(error_unit, '(a)') 'source: failed to open ' // trim(shell%source_file)
923 shell%last_exit_status = 1
924 return
925 end if
926
927 ! Increment source depth for return tracking
928 shell%source_depth = shell%source_depth + 1
929
930 ! Execute each line in the file
931 do
932 read(file_unit, '(a)', iostat=iostat) input_line
933 if (iostat /= 0) exit ! End of file or error
934
935 ! Skip empty lines and comments
936 if (len_trim(input_line) == 0 .or. input_line(1:1) == '#') cycle
937
938 ! Check for unclosed quotes or backslash continuation
939 do while (has_unclosed_quote(input_line) .or. ends_with_continuation_backslash(input_line))
940 read(file_unit, '(a)', iostat=iostat) continuation_line
941 if (iostat /= 0) exit ! End of file during continuation
942 ! Append the continuation line with a newline character
943 input_line = trim(input_line) // char(10) // trim(continuation_line)
944 end do
945
946 ! Handle line continuation (backslash-newline)
947 input_line = remove_line_continuations(input_line)
948
949 ! If EOF was reached during continuation, exit
950 if (iostat /= 0) exit
951
952 ! Check for unclosed compound commands (if/fi, do/done, case/esac)
953 do while (needs_compound_continuation(input_line))
954 read(file_unit, '(a)', iostat=iostat) continuation_line
955 if (iostat /= 0) exit ! End of file during compound command
956 ! Skip comment-only continuation lines but still append them
957 input_line = trim(input_line) // char(10) // trim(continuation_line)
958 end do
959
960 ! Handle heredocs: either read from file or extract from accumulated input
961 block
962 character(len=256) :: hd_delim
963 character(len=16384) :: hd_line, hd_stripped
964 character(len=16384) :: hd_content
965 integer :: hd_pos, hd_tab
966 logical :: hd_strip_tabs
967 hd_delim = get_heredoc_delimiter(input_line)
968 if (len_trim(hd_delim) > 0) then
969 ! If compound continuation already consumed the heredoc content
970 ! (delimiter line is in input_line), use -c preprocessor
971 if (has_heredoc_outside_quotes(input_line) .and. &
972 index(input_line, char(10)) > 0) then
973 input_line = preprocess_heredocs_for_c(input_line, shell)
974 else
975 ! Read heredoc content from file
976 hd_strip_tabs = (index(input_line, '<<-') > 0)
977 hd_content = ''
978 hd_pos = 1
979 do
980 read(file_unit, '(a)', iostat=iostat) hd_line
981 if (iostat /= 0) exit
982 if (hd_strip_tabs) then
983 hd_stripped = hd_line
984 hd_tab = 1
985 do while (hd_tab <= len_trim(hd_stripped) .and. hd_stripped(hd_tab:hd_tab) == char(9))
986 hd_tab = hd_tab + 1
987 end do
988 if (hd_tab > 1) hd_stripped = hd_stripped(hd_tab:)
989 if (trim(hd_stripped) == trim(hd_delim)) exit
990 else
991 if (trim(hd_line) == trim(hd_delim)) exit
992 end if
993 if (hd_pos > 1) then
994 hd_content(hd_pos:hd_pos) = char(10)
995 hd_pos = hd_pos + 1
996 end if
997 hd_content(hd_pos:hd_pos+len_trim(hd_line)-1) = trim(hd_line)
998 hd_pos = hd_pos + len_trim(hd_line)
999 end do
1000 hd_content(hd_pos:hd_pos) = char(10)
1001 hd_pos = hd_pos + 1
1002 shell%has_pending_heredoc = .true.
1003 shell%pending_heredoc = hd_content(:hd_pos-1)
1004 shell%pending_heredoc_delimiter = trim(hd_delim)
1005 block
1006 integer :: dq_pos
1007 dq_pos = index(input_line, "'" // trim(hd_delim) // "'")
1008 if (dq_pos == 0) dq_pos = index(input_line, '"' // trim(hd_delim) // '"')
1009 shell%pending_heredoc_quoted = (dq_pos > 0)
1010 end block
1011 shell%pending_heredoc_strip_tabs = hd_strip_tabs
1012 end if
1013 end if
1014 end block
1015
1016 ! Normal line processing
1017 ! Expand history if needed, then expand aliases
1018 ! NOTE: We do NOT add sourced file commands to history (only interactive commands)
1019 if (needs_history_expansion(input_line)) then
1020 history_expanded = expand_history(input_line)
1021 call expand_alias(shell, trim(history_expanded), expanded_line)
1022 else
1023 call expand_alias(shell, trim(input_line), expanded_line)
1024 end if
1025
1026 ! Process substitutions <() and >() before parsing
1027 call process_substitutions(shell, expanded_line, proc_subst_line)
1028
1029 ! POSIX set -v: Print input line before execution
1030 if (shell%option_verbose) then
1031 write(error_unit, '(A)') trim(input_line)
1032 end if
1033
1034 ! Parse and execute via AST
1035 converted_line = convert_backticks_to_dollar_paren(proc_subst_line)
1036 ast_root => parse_command_line(converted_line)
1037 if (associated(ast_root)) then
1038 if (shell%option_noexec) then
1039 exit_code = 0
1040 shell%last_exit_status = 0
1041 else
1042 exit_code = execute_ast(ast_root, shell)
1043 shell%last_exit_status = exit_code
1044 end if
1045
1046 ! Handle nested source commands (e.g., script calls source)
1047 if (shell%should_source) then
1048 call process_source_file(shell)
1049 end if
1050 else if (last_parse_had_error) then
1051 shell%last_exit_status = 2
1052 end if
1053
1054 ! Stop execution if exit command was encountered
1055 if (.not. shell%running) then
1056 exit
1057 end if
1058
1059 ! Stop execution if return was called from sourced script
1060 if (shell%function_return_pending .and. shell%source_depth > 0) exit
1061 end do
1062
1063 ! Fire RETURN trap if set (after sourced script finishes)
1064 block
1065 use signal_handling, only: get_trap_command, TRAP_RETURN
1066 use ast_executor, only: execute_ast_node
1067 character(len=4096) :: src_return_cmd
1068 src_return_cmd = get_trap_command(shell, TRAP_RETURN)
1069 if (len_trim(src_return_cmd) > 0 .and. &
1070 .not. shell%executing_trap) then
1071 block
1072 type(command_node_t), pointer :: trap_node
1073 integer :: saved_status_src
1074 logical :: saved_bypass_src
1075 saved_status_src = shell%last_exit_status
1076 saved_bypass_src = shell%bypass_functions
1077 shell%bypass_functions = .false.
1078 shell%executing_trap = .true.
1079 trap_node => parse_command_line(trim(src_return_cmd))
1080 if (associated(trap_node)) then
1081 exit_code = execute_ast_node(trap_node, shell)
1082 call destroy_command_node(trap_node)
1083 end if
1084 shell%executing_trap = .false.
1085 shell%bypass_functions = saved_bypass_src
1086 shell%last_exit_status = saved_status_src
1087 end block
1088 end if
1089 end block
1090
1091 ! Decrement source depth
1092 shell%source_depth = shell%source_depth - 1
1093
1094 ! Clear the return flag if we're exiting due to return in sourced script
1095 if (shell%function_return_pending .and. shell%function_depth == 0) then
1096 shell%function_return_pending = .false.
1097 end if
1098
1099 close(file_unit)
1100 shell%source_file = ''
1101 end subroutine
1102
1103 subroutine initialize_shell(shell)
1104 type(shell_state_t), intent(out) :: shell
1105 character(len=:), allocatable :: temp
1106 character(kind=c_char), target :: c_hostname(256)
1107 character(len=256) :: arg
1108 character(len=16) :: cols_str, rows_str
1109 integer :: ret, i, num_args
1110 logical :: success
1111
1112 ! Initialize allocatable arrays to avoid large stack allocation on macOS
1113 if (.not. allocated(shell%positional_params)) then
1114 allocate(shell%positional_params(50))
1115 shell%positional_params_capacity = 50
1116 do i = 1, 50
1117 shell%positional_params(i)%str = ''
1118 end do
1119 end if
1120 if (.not. allocated(shell%local_vars)) then
1121 allocate(shell%local_vars(MAX_CONTROL_DEPTH, MAX_LOCAL_VARS_PER_SCOPE))
1122 end if
1123 if (.not. allocated(shell%local_var_counts)) then
1124 allocate(shell%local_var_counts(MAX_CONTROL_DEPTH))
1125 shell%local_var_counts = 0
1126 end if
1127
1128 ! Detect if this is a login shell
1129 ! Check if argv[0] starts with '-' or if --login flag is present
1130 shell%is_login_shell = .false.
1131 num_args = command_argument_count()
1132
1133 ! Check argv[0] (program name)
1134 if (num_args >= 0) then
1135 call get_command_argument(0, arg)
1136 ! If program name starts with '-', it's a login shell
1137 if (len_trim(arg) > 0 .and. arg(1:1) == '-') then
1138 shell%is_login_shell = .true.
1139 end if
1140 end if
1141
1142 ! Check for --login flag
1143 do i = 1, num_args
1144 call get_command_argument(i, arg)
1145 if (trim(arg) == '--login' .or. trim(arg) == '-l') then
1146 shell%is_login_shell = .true.
1147 exit
1148 end if
1149 end do
1150
1151 ! Get username
1152 temp = get_environment_var('USER')
1153 if (len(temp) > 0) then
1154 shell%username = temp
1155 else
1156 shell%username = 'user'
1157 end if
1158
1159 ! Get hostname
1160 ret = c_gethostname(c_loc(c_hostname), 256_c_size_t)
1161 if (ret == 0) then
1162 shell%hostname = ''
1163 do i = 1, 256
1164 if (c_hostname(i) == c_null_char) exit
1165 shell%hostname(i:i) = c_hostname(i)
1166 end do
1167 else
1168 shell%hostname = 'localhost'
1169 end if
1170
1171 ! Get current directory
1172 shell%cwd = get_current_directory()
1173
1174 ! Check if shell is interactive (only if not already set by -c or script file)
1175 ! If execute_command_string or execute_script_file is true, we already set is_interactive = false
1176 if (.not. execute_command_string .and. .not. execute_script_file) then
1177 shell%is_interactive = (c_isatty(STDIN_FD) /= 0)
1178 end if
1179
1180 ! Setup job control if interactive
1181 if (shell%is_interactive) then
1182 shell%shell_pgid = c_getpid()
1183 ret = c_setpgid(shell%shell_pgid, shell%shell_pgid)
1184 shell%shell_terminal = STDIN_FD
1185 ret = c_tcsetpgrp(shell%shell_terminal, shell%shell_pgid)
1186 ! Enable monitor mode (job control) for interactive shells
1187 shell%option_monitor = .true.
1188 end if
1189
1190 ! Query terminal size (only if interactive to avoid SIGTTOU)
1191 if (shell%is_interactive) then
1192 success = get_terminal_size(shell%term_rows, shell%term_cols)
1193 ! Set COLUMNS and LINES in both environment and shell variables
1194 write(cols_str, '(I0)') shell%term_cols
1195 write(rows_str, '(I0)') shell%term_rows
1196 success = set_environment_var('COLUMNS', trim(cols_str))
1197 success = set_environment_var('LINES', trim(rows_str))
1198 call set_shell_variable(shell, 'COLUMNS', trim(cols_str))
1199 call set_shell_variable(shell, 'LINES', trim(rows_str))
1200 end if
1201
1202 ! Check terminal capabilities (ANSI support) - only if interactive
1203 if (shell%is_interactive) then
1204 shell%term_supports_color = terminal_supports_ansi()
1205 else
1206 shell%term_supports_color = .false.
1207 end if
1208
1209 ! Set initial terminal title if interactive (only for ANSI terminals)
1210 if (shell%is_interactive .and. shell%term_supports_color) then
1211 call set_terminal_title(trim(shell%username) // '@' // trim(shell%hostname) // ': ' // trim(shell%cwd))
1212 end if
1213
1214 ! Initialize other fields
1215 shell%last_exit_status = 0
1216 shell%last_pid = 0
1217 shell%running = .true.
1218 shell%num_jobs = 0
1219 shell%next_job_id = 1
1220
1221 ! Initialize history control variables
1222 temp = get_environment_var('HOME')
1223 if (len(temp) > 0) then
1224 shell%histfile = trim(temp) // '/.fortsh_history'
1225 else
1226 shell%histfile = ''
1227 end if
1228 shell%histsize = 1000
1229 shell%histfilesize = 2000
1230 shell%histcontrol = 'ignoredups' ! Default: ignore duplicate consecutive commands
1231
1232 ! Initialize shell options and special variables
1233 call initialize_shell_options(shell)
1234
1235 ! Save original stderr for shell messages (xtrace, errors, etc.)
1236 ! This ensures shell meta-output isn't affected by command redirections
1237 shell%original_stderr_fd = c_dup(STDERR_FD)
1238 if (shell%original_stderr_fd < 0) then
1239 shell%original_stderr_fd = STDERR_FD ! Fallback if dup fails
1240 end if
1241
1242 ! Initialize special shell variables
1243 shell%uid = get_uid()
1244 shell%euid = get_euid()
1245 call system_clock(shell%shell_start_time)
1246 shell%oldpwd = ''
1247 shell%last_arg = ''
1248 shell%pending_trap_command = ''
1249 shell%current_command = ''
1250 shell%ps1 = '%F{green}\u@\h%f :: %F{blue}\w%f\n> '
1251 shell%current_line_number = 0
1252
1253 ! Initialize jobs array
1254 do i = 1, MAX_JOBS
1255 shell%jobs(i)%job_id = 0
1256 end do
1257
1258 ! Initialize aliases array
1259 do i = 1, size(shell%aliases)
1260 shell%aliases(i)%name = ''
1261 shell%aliases(i)%command = ''
1262 end do
1263
1264 ! Initialize traps array
1265 do i = 1, size(shell%traps)
1266 shell%traps(i)%command = ''
1267 end do
1268
1269 ! Initialize control stack
1270 do i = 1, size(shell%control_stack)
1271 shell%control_stack(i)%condition_cmd = ''
1272 end do
1273
1274 ! Initialize coprocess registry (module-level, not part of shell_state_t)
1275 call init_coprocess_registry()
1276
1277 ! Initialize functions array
1278 do i = 1, size(shell%functions)
1279 shell%functions(i)%name = ''
1280 shell%functions(i)%body_lines = 0
1281 end do
1282
1283 ! Initialize prompt string lengths (to match default values in shell_state_t)
1284 shell%ps1_len = len_trim(shell%ps1) ! '\u@\h :: \w > ' = 17 chars
1285 shell%ps2_len = 2 ! '> ' = 2 chars (don't trim trailing space)
1286 shell%ps3_len = 3 ! '#? ' = 3 chars (don't trim trailing space)
1287 shell%ps4_len = 2 ! '+ ' = 2 chars (don't trim trailing space)
1288
1289 ! Check for performance monitoring environment variable
1290 temp = get_environment_var('FORTSH_PERF')
1291 if (len(temp) > 0 .and. trim(temp) == '1') then
1292 call set_performance_monitoring(.true.)
1293 end if
1294
1295 end subroutine
1296
1297 subroutine execute_trap_for_signal(shell, signum)
1298 use grammar_parser, only: parse_command_line, last_parse_had_error
1299 use ast_executor, only: execute_ast_node
1300 use command_tree, only: command_node_t, destroy_command_node
1301 type(shell_state_t), intent(inout) :: shell
1302 integer, intent(in) :: signum
1303 character(len=4096) :: trap_command
1304 type(command_node_t), pointer :: trap_ast
1305 integer :: saved_exit_status, trap_exit_code
1306
1307 ! Get the trap command for this signal
1308 trap_command = get_trap_command(shell, signum)
1309
1310 if (len_trim(trap_command) == 0) return
1311
1312 ! Don't execute inherited traps (visible in subshell but not executed)
1313 if (is_trap_inherited(shell, signum)) return
1314
1315 ! Save current exit status (trap should not affect $?)
1316 saved_exit_status = shell%last_exit_status
1317
1318 ! Don't execute trap if we're already in one
1319 if (shell%executing_trap) return
1320
1321 ! Don't execute EXIT trap if it was already executed by builtin_exit
1322 if (signum == 0 .and. shell%exit_trap_executed) return
1323
1324 ! Set flag to prevent recursive trap execution
1325 shell%executing_trap = .true.
1326
1327 ! Mark EXIT trap as executed if this is an EXIT trap
1328 if (signum == 0) shell%exit_trap_executed = .true.
1329
1330 ! Parse and execute trap command via AST
1331 trap_ast => parse_command_line(trim(trap_command))
1332 if (associated(trap_ast)) then
1333 trap_exit_code = execute_ast_node(trap_ast, shell)
1334 call destroy_command_node(trap_ast)
1335 else if (last_parse_had_error) then
1336 shell%last_exit_status = 2
1337 end if
1338
1339 ! Clear flag
1340 shell%executing_trap = .false.
1341
1342 ! Restore exit status
1343 shell%last_exit_status = saved_exit_status
1344 end subroutine
1345
1346 end program fortran_shell