subroutine run_fortran_file(filename, exit_code, verbose_level, custom_cache_dir, &
custom_config_dir, parallel_jobs, no_wait, custom_flags)
character(len=*), intent(in) :: filename
integer, intent(out) :: exit_code
integer, intent(in) :: verbose_level
character(len=*), intent(in) :: custom_cache_dir
character(len=*), intent(in) :: custom_config_dir
integer, intent(in) :: parallel_jobs
logical, intent(in) :: no_wait
character(len=*), intent(in), optional :: custom_flags
logical :: file_exists, success, file_exists_flag
character(len=256) :: cache_dir, project_dir, basename
character(len=512) :: command, flag_string
character(len=256) :: absolute_path, preprocessed_file, working_file
character(len=32) :: jobs_flag, content_hash
character(len=1024) :: preprocess_error
character(len=256) :: build_output_file
integer :: exitstat, cmdstat
integer :: i, last_slash
logical :: was_preprocessed, is_cache_miss
real :: start_time, end_time
exit_code = 0
! Initialize logger with current verbose level
call set_logger_verbose_level(verbose_level)
! Check if file exists
inquire (file=filename, exist=file_exists)
if (.not. file_exists) then
call print_error('File not found: '//trim(filename))
exit_code = 1
return
end if
! Check file extension
if (index(filename, '.f90') == 0 .and. index(filename, '.F90') == 0 .and. &
index(filename, '.lf') == 0 .and. index(filename, '.LF') == 0) then
call debug_print('Checking extension for file: '//trim(filename))
call print_error('Input file must have .f90, .F90, .lf, or .LF extension')
exit_code = 1
return
end if
! Get absolute path
call get_absolute_path(filename, absolute_path)
! Extract basename without extension
call get_basename(filename, basename)
! Check if file needs preprocessing
was_preprocessed = .false.
working_file = absolute_path
if (is_lazy_fortran_file(filename)) then
if (verbose_level >= 1) then
print '(a)', 'Processing Lowercase Fortran file with frontend...'
end if
! Get content-based cache directory first
if (len_trim(custom_cache_dir) > 0) then
cache_dir = trim(custom_cache_dir)
else
cache_dir = trim(get_cache_dir())
end if
call ensure_cache_dir(cache_dir, success)
if (.not. success) then
call print_error('Failed to create cache directory')
exit_code = 1
return
end if
! Generate content-based filename for preprocessed .lf file
content_hash = get_single_file_content_hash(absolute_path)
if (content_hash == 'fallback_unknown') then
! Fallback to basename if hashing fails
preprocessed_file = join_path(trim(cache_dir), 'preprocessed_'//trim(basename)//'.f90')
else
preprocessed_file = join_path(trim(cache_dir), 'preprocessed_'//trim(content_hash)//'.f90')
end if
! Check if already cached
inquire (file=preprocessed_file, exist=file_exists_flag)
if (.not. file_exists_flag) then
if (verbose_level >= 2) then
print '(a,a)', 'Creating preprocessed file: ', trim(preprocessed_file)
end if
! Preprocess the file using fortfront CLI
if (verbose_level >= 2) then
print '(a)', 'Using fortfront CLI preprocessor'
end if
call preprocess_with_cli(absolute_path, preprocessed_file, preprocess_error)
if (len_trim(preprocess_error) > 0) then
print '(a,a)', 'Error during preprocessing: ', trim(preprocess_error)
exit_code = 1
return
end if
! Debug: verify preprocessed file was created
inquire (file=preprocessed_file, exist=file_exists_flag)
if (.not. file_exists_flag) then
call print_error('Frontend did not create preprocessed file: '//trim(preprocessed_file))
exit_code = 1
return
end if
else
if (verbose_level >= 2) then
print '(a,a)', 'Using cached preprocessed file: ', trim(preprocessed_file)
end if
end if
! Verify preprocessed file exists
inquire (file=preprocessed_file, exist=file_exists_flag)
if (.not. file_exists_flag) then
call print_error('Preprocessed file not created: '//trim(preprocessed_file))
exit_code = 1
return
end if
! Keep track of preprocessed file
working_file = preprocessed_file
was_preprocessed = .true.
if (verbose_level >= 2) then
print '(a,a)', 'Preprocessed file ready: ', trim(preprocessed_file)
end if
end if
! Get cache directory (use custom if provided) - for .f90 files or if not set above
if (.not. is_lazy_fortran_file(filename)) then
if (len_trim(custom_cache_dir) > 0) then
cache_dir = trim(custom_cache_dir)
else
cache_dir = trim(get_cache_dir())
end if
end if
call ensure_cache_dir(cache_dir, success)
if (.not. success) then
call print_error('Failed to create cache directory')
exit_code = 1
return
end if
! Generate content-based hash for cache key
call get_project_hash_and_directory(absolute_path, basename, cache_dir, project_dir, verbose_level)
! Clean up stale locks on startup
call cleanup_stale_locks(cache_dir)
! Try to acquire lock for this project
if (.not. acquire_lock(cache_dir, basename,.not. no_wait)) then
if (no_wait) then
call print_error('Cache is locked by another process. Use without --no-wait to wait.')
else
call print_error('Timeout waiting for cache lock.')
end if
exit_code = 1
return
end if
! Check if project already exists (cache hit)
is_cache_miss = .not. directory_exists(join_path(trim(project_dir), 'build'))
if (.not. is_cache_miss) then
if (verbose_level >= 1) then
print '(a)', 'Cache hit: Using existing build'
end if
! Always update source files to allow incremental compilation
call update_source_files(working_file, trim(project_dir))
else
! Cache miss: need to set up project
if (verbose_level >= 1) then
print '(a)', 'Cache miss: Setting up new build'
else
! Quiet mode: show subtle indicator and start timing
write (*, '(a)', advance='no') 'Compiling... '
flush (6)
call cpu_time(start_time)
end if
! Create the project directory first
call mkdir(trim(project_dir))
! Verify the directory was created successfully
if (.not. directory_exists(trim(project_dir))) then
print '(a,a)', 'ERROR: Failed to create project directory: ', trim(project_dir)
exit_code = 1
call release_lock(cache_dir, basename)
return
end if
call mkdir(join_path(trim(project_dir), 'app'))
! Verify app directory was created
if (.not. directory_exists(join_path(trim(project_dir), 'app'))) then
call print_error('Failed to create app directory in: '//trim(project_dir))
exit_code = 1
call release_lock(cache_dir, basename)
return
end if
! Verify working file exists before copying
inquire (file=trim(working_file), exist=file_exists_flag)
if (.not. file_exists_flag) then
call print_error('Working file does not exist: '//trim(working_file))
exit_code = 1
call release_lock(cache_dir, basename)
return
end if
! Copy source files and generate FPM project only on cache miss
if (present(custom_flags)) then
call setup_project_files(trim(working_file), trim(project_dir), basename, verbose_level, &
custom_config_dir, was_preprocessed, custom_flags)
else
call setup_project_files(trim(working_file), trim(project_dir), basename, verbose_level, &
custom_config_dir, was_preprocessed, '')
end if
end if
! Generate flag string based on file type and user input
if (present(custom_flags)) then
call generate_flag_string(was_preprocessed, custom_flags, flag_string)
else
call generate_flag_string(was_preprocessed, '', flag_string)
end if
! Build first
! Prepare parallel jobs flag if specified
! NOTE: Current FPM version (0.12.0) doesn't support -j flag
! This is prepared for future versions that will support it
if (parallel_jobs > 0) then
write (jobs_flag, '(a,i0,a)') ' --jobs ', parallel_jobs, ' '
if (verbose_level >= 1) then
print '(a,i0,a)', 'Note: Parallel builds requested (', parallel_jobs, &
' jobs) but current FPM version does not support --jobs flag'
end if
else
jobs_flag = ' '
end if
if (verbose_level == 0) then
! Quiet mode: capture output for error reporting
build_output_file = create_temp_file('fortran_build_fpm_build_output', '.txt')
if (len_trim(flag_string) > 0) then
command = trim(get_cd_command())//' "'//trim(escape_shell_arg(project_dir))//'" && '// &
'fpm build --flag "'//trim(escape_shell_arg(flag_string))//'" > "'//trim(escape_shell_arg(build_output_file))//'" 2>&1'
else
command = trim(get_cd_command())//' "'//trim(escape_shell_arg(project_dir))//'" && '// &
'fpm build > "'//trim(escape_shell_arg(build_output_file))//'" 2>&1'
end if
else if (verbose_level >= 2) then
! Very verbose: show detailed build output
if (len_trim(flag_string) > 0) then
command = trim(get_cd_command())//' "'//trim(escape_shell_arg(project_dir))//'" && '// &
'fpm build --verbose --flag "'//trim(escape_shell_arg(flag_string))//'"'
else
command = trim(get_cd_command())//' "'//trim(escape_shell_arg(project_dir))//'" && '// &
'fpm build --verbose'
end if
else
! Normal verbose: show build progress
if (len_trim(flag_string) > 0) then
command = trim(get_cd_command())//' "'//trim(escape_shell_arg(project_dir))//'" && '// &
'fpm build --flag "'//trim(escape_shell_arg(flag_string))//'"'
else
command = trim(get_cd_command())//' "'//trim(escape_shell_arg(project_dir))//'" && '// &
'fpm build'
end if
end if
! TODO: Add jobs_flag when FPM supports it
! Future: 'fpm build' // trim(jobs_flag) // '--flag ...
call debug_print('About to execute FPM build command: '//trim(command))
call debug_print('Project directory: '//trim(project_dir))
call execute_command_line(command, exitstat=exitstat, cmdstat=cmdstat, wait=.true.)
! Calculate timing but don't show yet
if (verbose_level == 0 .and. is_cache_miss) then
call cpu_time(end_time)
end if
if (cmdstat /= 0 .or. exitstat /= 0) then
if (verbose_level == 0) then
! Show timing even on error
if (is_cache_miss) then
write (*, '(f0.1,a)') end_time - start_time, 's'
end if
! Show the build errors
call show_build_errors(build_output_file)
! Clean up temp file
call sys_remove_file(build_output_file)
end if
call release_lock(cache_dir, basename)
exit_code = 1
return
end if
! Cache newly compiled dependency modules after successful build
call cache_build_artifacts(trim(project_dir), verbose_level)
! Show timing after successful build for cache miss
if (verbose_level == 0 .and. is_cache_miss) then
write (*, '(f0.1,a)') end_time - start_time, 's'
end if
! Clean up build output file if it was created
if (verbose_level == 0) then
call sys_remove_file(build_output_file)
end if
! Run the executable using fpm run
if (verbose_level == 0) then
! Quiet mode: capture output to filter FPM messages but show errors
block
character(len=256) :: temp_output
integer :: unit, iostat
character(len=1024) :: line
logical :: has_error
temp_output = create_temp_file('fortran_run_output', '.txt')
! Run fpm and capture all output
command = trim(get_cd_command())//' "'//trim(escape_shell_arg(project_dir))//'" && fpm run "'// &
trim(escape_shell_arg(basename))//'" > "'//trim(escape_shell_arg(temp_output))//'" 2>&1'
call debug_print('Running command: '//trim(command))
call execute_command_line(command, exitstat=exitstat, cmdstat=cmdstat, wait=.true.)
! Check if there was an error
has_error = (cmdstat /= 0 .or. exitstat /= 0)
! Read and filter output
open (newunit=unit, file=temp_output, status='old', iostat=iostat)
if (iostat == 0) then
do
read (unit, '(a)', iostat=iostat) line
if (iostat /= 0) exit
! Filter out FPM progress messages unless there's an error
if (has_error) then
! Show everything on error
write (*, '(a)') trim(line)
else
! Filter out FPM messages on success
if (index(line, '[') == 0 .or. index(line, '%]') == 0) then
if (index(line, 'Project is up to date') == 0 .and. &
index(line, 'Project compiled successfully') == 0) then
write (*, '(a)') trim(line)
end if
end if
end if
end do
close (unit)
end if
! Clean up temp file
call sys_remove_file(temp_output)
end block
else
command = trim(get_cd_command())//' "'//trim(escape_shell_arg(project_dir))// &
'" && fpm run "'//trim(escape_shell_arg(basename))//'"'
call debug_print('Running command: '//trim(command))
call execute_command_line(command, exitstat=exitstat, cmdstat=cmdstat, wait=.true.)
end if
if (cmdstat /= 0) then
call print_error('Failed to execute fpm')
exit_code = 1
else if (exitstat /= 0) then
! FPM returned non-zero, likely compilation error
exit_code = exitstat
end if
! Release the lock
call release_lock(cache_dir, basename)
! Clean up (optional for now - we might want to keep for caching)
! command = 'rm -rf "' // trim(project_dir) // '"'
! call execute_command_line(command)
end subroutine run_fortran_file