61 use iso_fortran_env,
only : iostat_end
69 implicit none;
private
74 integer,
parameter,
private :: INCLUDE_TYPE_SYSTEM = 1
75 integer,
parameter,
private :: INCLUDE_TYPE_LOCAL = 2
77 integer,
parameter,
private :: MAX_PATH_LEN = 256
79 integer,
parameter,
private :: MAX_PATH_LEN = 4096
88 subroutine read_unit(iunit, ounit, macros, from_include)
91 integer,
intent(in) :: iunit
92 integer,
intent(in) :: ounit
93 type(macro),
allocatable,
intent(inout) :: macros(:)
94 logical,
intent(in) :: from_include
117 recursive subroutine handle_include(input, ounit, parent_file, iline, preprocess, macros, token)
118 character(*),
intent(in) :: input
119 integer,
intent(in) :: ounit
120 character(*),
intent(in) :: parent_file
121 integer,
intent(in) :: iline
123 type(
macro),
allocatable,
intent(inout) :: macros(:)
124 character(*),
intent(in) :: token
126 character(:),
allocatable :: include_file
127 character(:),
allocatable :: dir, ifile
128 character(:),
allocatable :: sys_paths(:)
129 integer :: i, iunit, ierr, pos
130 integer :: include_type
137 include_file =
trim(adjustl(input(pos:)))
140 if (include_file(1:1) ==
'"')
then
141 include_type = include_type_local
142 include_file = include_file(2:index(include_file(2:),
'"'))
143 else if (include_file(1:1) ==
'<')
then
144 include_type = include_type_system
145 include_file = include_file(2:index(include_file(2:),
'>'))
148 if (
verbose) print *,
'Error: Malformed #include directive at ',
trim(parent_file),
':', iline
155 inquire(file=ifile, exist=exists)
160 print *,
"Error: Cannot find include file '",
trim(include_file),
"' at ",
trim(parent_file),
":", iline
168 ifile =
join(dir, include_file)
169 if (include_type == include_type_local)
then
170 ifile =
join(dir, include_file)
171 inquire(file=ifile, exist=exists)
178 if (.not. exists .and.
allocated(
global%includedir))
then
179 do i = 1,
size(
global%includedir)
180 ifile =
join(
global%includedir(i), include_file)
181 inquire(file=ifile, exist=exists)
190 if (.not. exists)
then
192 character(:),
allocatable :: ipaths(:)
195 do i = 1,
size(ipaths)
196 ifile =
join(ipaths(i), include_file)
197 inquire(file=ifile, exist=exists)
206 if (.not. exists)
then
207 ifile =
join(
cwd(), include_file)
208 inquire(file=ifile, exist=exists)
215 if (.not. exists)
then
216 if (
verbose) print *,
"Error: Cannot find include file '",
trim(include_file),
"' at ",
trim(parent_file),
":", iline
222 open(newunit=iunit, file=include_file, status=
'old', action=
'read', iostat=ierr)
224 if (
verbose) print *,
"Error: Cannot open include file '",
trim(include_file),
"' at ",
trim(parent_file),
":", iline
228 call preprocess(iunit, ounit, macros, .true.)
239 character(:),
allocatable :: paths(:)
241 character(:),
allocatable :: path_env, tmp(:)
242 integer :: lpath, i, n_paths, start_pos, end_pos, count
243 character(len=1) :: path_sep
252 call get_environment_variable(
'INCLUDE', length=lpath)
254 allocate(
character(len=0) :: paths(0)); return
258 allocate(
character(len=lpath) :: path_env)
259 call get_environment_variable(
'INCLUDE',
value=path_env)
263 do i = 1, len(path_env)
264 if (path_env(i:i) == path_sep) n_paths = n_paths + 1
268 allocate(
character(len=MAX_PATH_LEN) :: tmp(n_paths))
273 do i = 1, len(path_env) + 1
274 if (i > len(path_env) .or. path_env(i:i) == path_sep)
then
275 if (i > len(path_env))
then
281 if (end_pos >= start_pos)
then
283 tmp(count) = trim(adjustl(path_env(start_pos:end_pos)))
291 allocate(
character(len=MAX_PATH_LEN) :: paths(count))
292 paths(:) = tmp(1:count)
294 allocate(
character(len=0) :: paths(0))
type(global_settings), public global
The single global instance used throughout fpx Initialized automatically with sensible defaults value...
recursive subroutine, public handle_include(input, ounit, parent_file, iline, preprocess, macros, token)
Process a include directive encountered during preprocessing Resolves the include file name (quoted o...
character(:) function, dimension(:), allocatable get_system_paths()
Get system include paths from PATH environment variable Returns an array of directory paths found in ...
logical, public verbose
Master switch for verbose diagnostic output Default value is .false. (quiet mode)....
pure logical function is_rooted(filepath)
Returns .true. if the path is rooted (starts with a separator) or is absolute. A rooted path begins w...
pure character(:) function, allocatable dirpath(filepath)
Returns the directory part of a path (everything before the last separator).
character(:) function, allocatable cwd()
Returns the current working directory as a deferred-length character string. Returns empty string on ...
pure character(len_trim(str)) function, public uppercase(str)
Convert string to upper case (respects contents of quotes).
Abstract interface for the main preprocessing routine (used for recursion) Allows handle_include to r...
Generic interface for joining two path components Supports all combinations of character and string a...
Return the length of a string.
Return the trimmed string.
Derived type representing a single preprocessor macro Extends string with macro-specific fields: rep...