include.f90

Go to the documentation of this file.

!> @file
!! @defgroup group_include Include
!! Include file handling and resolution for the fpx Fortran preprocessor
!!
!! This module implements robust and standard-compliant processing of `#include` directives
!! with full support for:
!! - Both forms: `#include "file.h"` (local/user) and `#include <file.h>` (system)
!! - Proper search order: quotes search source dir first, angle brackets skip source dir
!! - Relative paths resolved against the directory of the parent source file
!! - Search in user-defined include directories (`global%includedir`)
!! - Search in system INCLUDE environment variable directories
!! - Fallback to current working directory
!! - Proper error reporting with file name and line number context
!! - Recursion safety through integration with the main preprocessor loop
!! - Seamless integration via the abstract `preprocess` procedure pointer
!!
!! The routine correctly strips quotes or angle brackets, performs path resolution,
!! checks file existence, opens the file, and recursively invokes the main preprocessing
!! engine on the included content using the same macro environment.
!!
!! @note
!! For `#include "file"`:
!! 1. Directory of the parent source file
!! 2. Directories specified by the -I option (`global%includedir`)
!! 3. Directories in INCLUDE environment variable
!! 4. Current working directory
!!
!! @note
!! For `#include <file>`:
!! 1. Directories specified by the -I option (`global%includedir`)
!! 2. Directories in INCLUDE environment variable
!! 3. Current working directory
!!
!! @note
!! Nested includes are supported. Relative paths inside included
!! files are resolved relative to the directory containing the
!! including file.
!!
!! @section include_examples Examples
!!
!! 1. Include a local header from the same directory using quotes:
!! @code{.f90}
!!    #include "config.h"
!!    !> fpx will look for ./config.h relative to the current source file first
!! @endcode
!!
!! 2. Include a system header using angle brackets:
!! @code{.f90}
!!    #include <stdlib.h>
!!    !> fpx will skip the source directory and search -I paths, then INCLUDE
!! @endcode
!!
!! 3. Using from the driver program (adding include paths):
!! @code{.f90}
!!    global%includedir = ['/usr/include', './include', './headers']
!!    call preprocess('main.F90', 'main.f90')
!!    !> All #include <...> will search these directories in order
!! @endcode
!!
!! 4. Verbose error reporting when a file is not found:
!! @code{.txt}
!!    $ fpx -v src/utils.F90
!!    Error: Cannot find include file 'missing.h' at src/utils.F90:27
!! @endcode
module fpx_include
    use iso_fortran_env, only : iostat_end
    use fpx_constants
    use fpx_logging
    use fpx_path
    use fpx_string
    use fpx_macro
    use fpx_global
    use fpx_context
 
    implicit none; private
 
    public :: handle_include
 
    ! Include directive types
    integer, parameter, private :: INCLUDE_TYPE_SYSTEM = 1  ! < >
    integer, parameter, private :: INCLUDE_TYPE_LOCAL = 2  ! " "
#ifdef _WIN32
    integer, parameter, private :: MAX_PATH_LEN = 256
#else
    integer, parameter, private :: MAX_PATH_LEN = 4096
#endif
 
contains
 
    !> Process a #include directive encountered during preprocessing
    !! Resolves the include file name (quoted or angle-bracketed), searches for the file
    !! using standard C preprocessor rules:
    !! - Quoted includes search: parent directory, -I paths, INCLUDE, cwd
    !! - Angle bracket includes search: -I paths, INCLUDE, cwd (skips parent directory)
    !! Opens the file and recursively preprocesses its contents into the output unit.
    !!
    !! @param[in] ctx          Context line containing the #include directive
    !! @param[in] ounit        Output unit where preprocessed content is written
    !! @param[in] preprocess   Procedure pointer to the main line-by-line preprocessor
    !! @param[inout] macros    Current macro table (shared across recursion levels)
    !! @param[in] token        Usually 'include' - the directive keyword
    !!
    !! @ingroup group_include
    recursive subroutine handle_include(ctx, ounit, preprocess, macros, token)
        type(context), intent(in)               :: ctx
        integer, intent(in)                     :: ounit
        procedure(read_unit)                    :: preprocess
        type(macro), allocatable, intent(inout) :: macros(:)
        character(*), intent(in)                :: token
        !private
        type(string), allocatable, save :: include_stack(:)
        character(:), allocatable :: include_file
        character(:), allocatable :: dir, ifile
        integer :: i, iunit, ierr, pos, include_type, closing
        logical :: exists
 
        ! Extract the directory of the parent file
        dir = dirpath(ctx%path)
        ! Find the position after the #include token
        pos = index(lowercase(ctx%content), token) + len(token)
        include_file = trim(adjustl(ctx%content(pos:)))
 
        ! Determine include type and extract filename
        if (include_file(1:1) == '"') then
            include_type = include_type_local
            closing = index(include_file(2:), '"')
            if (closing == 0) then
                call printf(render(diagnostic_report(level_error, &
                        message='Malformed #include directive', &
                        label=label_type('Missing closing quotation mark', &
                        index(ctx%content,'"'),1), &
                        source=trim(ctx%path)), &
                        ctx%content, ctx%line))
                return
            end if
            include_file = include_file(2:closing)
        else if (include_file(1:1) == '<') then
            include_type = include_type_system
            closing = index(include_file(2:), '>')
            if (closing == 0) then
                call printf(render(diagnostic_report(level_error, &
                        message='Malformed #include directive', &
                        label=label_type('Missing closing quotation mark', &
                        index(ctx%content,'"'),1), &
                        source=trim(ctx%path)), &
                        ctx%content, ctx%line))
                return
            end if
            include_file = include_file(2:closing)
        else
            ! Malformed include directive
            call printf(render(diagnostic_report(level_error, &
                    message='Malformed #include directive', &
                    label=label_type('Filepath should either be delimited by "<...>" or "..."', index(ctx%content, include_file), &
                    len(include_file)), &
                    source=trim(ctx%path)), &
                    ctx%content, ctx%line))
            return
        end if
 
        ! Handle absolute/rooted paths (same for both types)
        ifile = include_file
        if (is_rooted(ifile)) then
            inquire(file=ifile, exist=exists)
            if (exists) then
                include_file = ifile
            else
                call printf(render(diagnostic_report(level_error, &
                        message='File not found', &
                        label=label_type('Cannot find include file ' // trim(include_file), index(ctx%content, include_file), &
                        len(include_file)), &
                        source=trim(ctx%path)), &
                        ctx%content, ctx%line))
                return
            end if
        else
            ! Relative path - search according to include type
            exists = .false.
            ! For quoted includes (#include "file"), search parent directory first
            if (include_type == include_type_local) then
                ifile = join(dir, include_file)
                inquire(file=ifile, exist=exists)
                if (exists) then
                    include_file = ifile
                end if
            end if
 
            ! If not found yet, search user-specified include directories (-I paths)
            if (.not. exists .and. allocated(global%includedir)) then
                do i = 1, size(global%includedir)
                    ifile = join(global%includedir(i), include_file)
                    inquire(file=ifile, exist=exists)
                    if (exists) then
                        include_file = ifile
                        exit
                    end if
                end do
            end if
 
            ! If still not found, try the INCLUDE environmental variable
            if (.not. exists) then
                block
                    character(:), allocatable :: ipaths(:)
 
                    ipaths = get_system_paths()
                    do i = 1, size(ipaths)
                        ifile = join(ipaths(i), include_file)
                        inquire(file=ifile, exist=exists)
                        if (exists) then
                            include_file = ifile
                        end if
                    end do
                end block
            end if
 
            ! If still not found, try current working directory as last resort
            if (.not. exists) then
                ifile = join(cwd(), include_file)
                inquire(file=ifile, exist=exists)
                if (exists) then
                    include_file = ifile
                end if
            end if
 
            ! If file was not found anywhere, report error
            if (.not. exists) then
                call printf(render(diagnostic_report(level_error, &
                        message='File not found', &
                        label=label_type('Cannot find include file ' // trim(include_file), index(ctx%content, include_file), len(&
                        include_file)), &
                        source=trim(ctx%path)), &
                        ctx%content, ctx%line))
                return
            end if
        end if
 
        if (.not. allocated(include_stack)) allocate(include_stack(0))
 
        if (include_stack .contains. include_file) then
            call printf(render(diagnostic_report(level_error, &
                    message='Recursive include detected', &
                    label=label_type('File already included in current include chain', &
                                    index(ctx%content, trim(include_file)), &
                                    len_trim(include_file)), &
                    source=trim(ctx%path)), &
                    ctx%content, ctx%line))
            return
        end if
 
        ! Open and preprocess the include file
        open(newunit=iunit, file=include_file, status='old', action='read', iostat=ierr)
        if (ierr /= 0) then
            call printf(render(diagnostic_report(level_error, &
                    message='File not found', &
                    label=label_type('Cannot open include file ' // trim(include_file), index(ctx%content, include_file), len(&
                    include_file)), &
                    source=trim(ctx%path)), &
                    ctx%content, ctx%line))
            return
        end if
 
        include_stack = [include_stack, string(include_file)]
 
        call preprocess(iunit, ounit, macros, .true.)
        close(iunit)
        if (size(include_stack) > 1) then
            include_stack = include_stack(:size(include_stack)-1)
        else
            deallocate(include_stack)
        end if
    end subroutine
 
    !> Get system include paths from INCLUDE environment variable
    !! Returns an array of directory paths found in INCLUDE
    !! @return Array of path strings, empty if INCLUDE not set
    !!
    !! @ingroup group_include
    function get_system_paths() result(paths)
        character(:), allocatable :: paths(:)
        !private
        character(:), allocatable :: path_env, tmp(:)
        integer :: lpath, i, n_paths, start_pos, end_pos, count
        character(len=1) :: path_sep
 
#ifdef _WIN32
        path_sep = ';'  ! Windows path separator
#else
        path_sep = ':'  ! Unix/Linux/Mac path separator
#endif
 
        ! Get INCLUDE environment variable length
        call get_environment_variable('INCLUDE', length=lpath)
        if (lpath <= 0) then
            allocate(character(len=0) :: paths(0)); return
        end if
 
        ! Allocate and retrieve INCLUDE value
        allocate(character(len=lpath) :: path_env)
        call get_environment_variable('INCLUDE', value=path_env)
 
        ! Count number of paths (number of separators + 1)
        n_paths = 1
        do i = 1, len(path_env)
            if (path_env(i:i) == path_sep) n_paths = n_paths + 1
        end do
 
        ! Allocate temporary array with maximum size
        allocate(character(len=MAX_PATH_LEN) :: tmp(n_paths))
 
        ! Split INCLUDE into individual directories
        count = 0
        start_pos = 1
        do i = 1, len(path_env) + 1
            if (i > len(path_env) .or. path_env(i:i) == path_sep) then
                if (i > len(path_env)) then
                    end_pos = i - 1
                else
                    end_pos = i - 1
                end if
 
                if (end_pos >= start_pos) then
                    count = count + 1
                    tmp(count) = trim(adjustl(path_env(start_pos:end_pos)))
                end if
                start_pos = i + 1
            end if
        end do
 
        ! Allocate result array with actual count
        if (count > 0) then
            allocate(character(len=MAX_PATH_LEN) :: paths(count))
            paths(:) = tmp(1:count)
        else
            allocate(character(len=0) :: paths(0))
        end if
    end function
 
end module