16
16
! >
17
17
module fpm_source_parsing
18
18
use fpm_error, only: error_t, file_parse_error, fatal_error, file_not_found_error
19
- use fpm_strings, only: string_t, string_cat, len_trim, split, lower, str_ends_with, fnv_1a, is_fortran_name
19
+ use fpm_strings, only: string_t, string_cat, len_trim, split, lower, str_ends_with, fnv_1a, &
20
+ is_fortran_name, operator (.in .), operator (==)
20
21
use fpm_model, only: srcfile_t, &
21
22
FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, &
22
23
FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, &
23
24
FPM_UNIT_CSOURCE, FPM_UNIT_CHEADER, FPM_SCOPE_UNKNOWN, &
24
25
FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST, FPM_UNIT_CPPSOURCE
26
+ use fpm_manifest_preprocess, only: preprocess_config_t
25
27
use fpm_filesystem, only: read_lines, read_lines_expanded, exists
26
28
implicit none
27
29
28
30
private
29
31
public :: parse_f_source, parse_c_source, parse_use_statement
30
32
33
+ type :: cpp_block
34
+ ! Nested block total depth
35
+ integer :: depth = 0
36
+ ! Whether currently inside an inactive conditional block
37
+ logical :: inside_inactive_block = .false.
38
+ ! Depth at which we became inactive (0 if active)
39
+ integer :: inactive_depth = 0
40
+ ! Current macro
41
+ character (:), allocatable :: name
42
+ end type cpp_block
43
+
31
44
contains
32
45
46
+ ! > Case-insensitive check if macro_name is in the macros list
47
+ logical function macro_in_list (macro_name , macros )
48
+ character (* ), intent (in ) :: macro_name
49
+ type (string_t), optional , intent (in ) :: macros(:)
50
+ integer :: i
51
+
52
+ type (string_t) :: lmacro
53
+
54
+ macro_in_list = .false.
55
+ if (.not. present (macros)) return
56
+
57
+ macro_in_list = macro_name .in . macros
58
+
59
+ end function macro_in_list
60
+
61
+ ! > Start a CPP conditional block (active or inactive)
62
+ subroutine start_cpp_block (blk , lower_line , line , preprocess )
63
+ type (cpp_block), intent (inout ) :: blk
64
+ character (* ), intent (in ) :: lower_line, line
65
+ type (preprocess_config_t), optional , intent (in ) :: preprocess
66
+
67
+ logical :: is_active
68
+ character (:), allocatable :: macro_name
69
+
70
+ call parse_cpp_condition(lower_line, line, preprocess, is_active, macro_name)
71
+
72
+ blk% depth = blk% depth + 1
73
+
74
+ ! If we're not already in an inactive block, check this condition
75
+ enter_inactive: if (.not. blk% inside_inactive_block) then
76
+ blk% name = macro_name
77
+ if (.not. is_active) then
78
+ ! This condition is false, so we enter an inactive block
79
+ blk% inside_inactive_block = .true.
80
+ blk% inactive_depth = blk% depth
81
+ end if
82
+ end if enter_inactive
83
+
84
+ ! If we're already in an inactive block, stay inactive regardless of this condition
85
+
86
+ end subroutine start_cpp_block
87
+
88
+ ! > End a CPP conditional block
89
+ subroutine end_cpp_block (blk )
90
+ type (cpp_block), intent (inout ) :: blk
91
+
92
+ ! If we're ending the block where we became inactive, reactivate
93
+ if (blk% inside_inactive_block .and. blk% depth == blk% inactive_depth) then
94
+ blk% inside_inactive_block = .false.
95
+ blk% inactive_depth = 0
96
+ end if
97
+
98
+ blk% depth = max (0 , blk% depth - 1 )
99
+
100
+ end subroutine end_cpp_block
101
+
102
+ ! > Handle #else directive by flipping the current condition
103
+ subroutine handle_else_block (blk )
104
+ type (cpp_block), intent (inout ) :: blk
105
+
106
+ ! #else only matters if we're at the same level where we became inactive
107
+ if (blk% inside_inactive_block .and. blk% depth == blk% inactive_depth) then
108
+ ! We're in an inactive block at this level, #else makes it active
109
+ blk% inside_inactive_block = .false.
110
+ blk% inactive_depth = 0
111
+ elseif (.not. blk% inside_inactive_block .and. blk% depth > 0 ) then
112
+ ! We're in an active block at this level, #else makes it inactive
113
+ blk% inside_inactive_block = .true.
114
+ blk% inactive_depth = blk% depth
115
+ end if
116
+
117
+ end subroutine handle_else_block
118
+
119
+ ! > Parse CPP conditional directive and determine if block should be active
120
+ subroutine parse_cpp_condition (lower_line , line , preprocess , is_active , macro_name )
121
+ character (* ), intent (in ) :: lower_line, line
122
+ type (preprocess_config_t), optional , intent (in ) :: preprocess
123
+ character (:), allocatable , intent (out ) :: macro_name
124
+ logical , intent (out ) :: is_active
125
+ integer :: start_pos, end_pos, heading_blanks, i
126
+
127
+ ! Always active if CPP preprocessor is not active
128
+ if (.not. present (preprocess)) then
129
+ is_active = .true.
130
+ macro_name = " "
131
+ return
132
+ endif
133
+
134
+ ! If CPP is not enabled, always active
135
+ if (.not. preprocess% is_cpp()) then
136
+ is_active = .true.
137
+ macro_name = " "
138
+ return
139
+ endif
140
+
141
+ ! Find offset between lowercase adjustl and standard line
142
+ heading_blanks = 0
143
+ do i= 1 ,len (line)
144
+ if (line(i:i)==' ' ) then
145
+ heading_blanks = heading_blanks+1
146
+ else
147
+ exit
148
+ end if
149
+ end do
150
+
151
+ ! There are macros: test if active
152
+ if (index (lower_line, ' #ifdef' ) == 1 ) then
153
+ ! #ifdef MACRO
154
+ start_pos = index (lower_line, ' ' ) + heading_blanks + 1
155
+
156
+ ! Pick non-lowercase macro name
157
+ macro_name = trim (adjustl (line(start_pos:)))
158
+ is_active = macro_in_list(macro_name, preprocess% macros)
159
+
160
+ elseif (index (lower_line, ' #ifndef' ) == 1 ) then
161
+ ! #ifndef MACRO
162
+ start_pos = index (lower_line, ' ' ) + heading_blanks + 1
163
+ macro_name = trim (adjustl (line(start_pos:)))
164
+ is_active = .not. macro_in_list(macro_name, preprocess% macros)
165
+
166
+ elseif (index (lower_line, ' #if ' ) == 1 ) then
167
+ ! Handle various #if patterns
168
+ if (index (lower_line, ' defined(' ) > 0 ) then
169
+ ! #if defined(MACRO) or #if !defined(MACRO)
170
+ start_pos = index (lower_line, ' defined(' ) + 8
171
+ end_pos = index (lower_line(start_pos:), ' )' ) - 1
172
+
173
+ start_pos = start_pos+ heading_blanks
174
+ end_pos = end_pos+ heading_blanks
175
+
176
+ if (end_pos > 0 ) then
177
+ macro_name = line(start_pos:start_pos + end_pos - 1 )
178
+ if (index (lower_line, ' !defined(' ) > 0 ) then
179
+ is_active = .not. macro_in_list(macro_name, preprocess% macros)
180
+ else
181
+ is_active = macro_in_list(macro_name, preprocess% macros)
182
+ end if
183
+ else
184
+ ! More complex condition
185
+ is_active = .false.
186
+ end if
187
+ else
188
+ ! #if MACRO (simple macro check)
189
+ start_pos = 4 + heading_blanks ! Skip "#if "
190
+ end_pos = len_trim (lower_line) + heading_blanks
191
+ macro_name = trim (adjustl (line(start_pos:end_pos)))
192
+ is_active = macro_in_list(macro_name, preprocess% macros)
193
+ end if
194
+ else
195
+ is_active = .false.
196
+ end if
197
+
198
+ end subroutine parse_cpp_condition
199
+
33
200
! > Parsing of free-form fortran source files
34
201
! >
35
202
! > The following statements are recognised and parsed:
@@ -63,14 +230,17 @@ module fpm_source_parsing
63
230
! > my_module
64
231
! >```
65
232
! >
66
- function parse_f_source (f_filename ,error ) result(f_source)
233
+ function parse_f_source (f_filename ,error , preprocess ) result(f_source)
67
234
character (* ), intent (in ) :: f_filename
68
- type (srcfile_t) :: f_source
69
235
type (error_t), allocatable , intent (out ) :: error
236
+ type (preprocess_config_t), optional , intent (in ) :: preprocess
237
+ type (srcfile_t) :: f_source
70
238
71
239
logical :: inside_module, inside_interface, using, intrinsic_module
240
+ logical :: cpp_conditional_parsing
72
241
integer :: stat
73
242
integer :: fh, n_use, n_include, n_mod, n_parent, i, j, ic, pass
243
+ type (cpp_block) :: cpp_blk
74
244
type (string_t), allocatable :: file_lines(:), file_lines_lower(:)
75
245
character (:), allocatable :: temp_string, mod_name, string_parts(:)
76
246
@@ -80,7 +250,11 @@ function parse_f_source(f_filename,error) result(f_source)
80
250
end if
81
251
82
252
f_source% file_name = f_filename
83
-
253
+
254
+ ! Only use conditional parsing if preprocessing is enabled with CPP
255
+ cpp_conditional_parsing = .false.
256
+ if (present (preprocess)) cpp_conditional_parsing = preprocess% is_cpp()
257
+
84
258
file_lines = read_lines_expanded(f_filename)
85
259
86
260
! for efficiency in parsing make a lowercase left-adjusted copy of the file
@@ -100,15 +274,55 @@ function parse_f_source(f_filename,error) result(f_source)
100
274
n_parent = 0
101
275
inside_module = .false.
102
276
inside_interface = .false.
277
+ cpp_blk = cpp_block() ! Initialize with default values
103
278
file_loop: do i= 1 ,size (file_lines_lower)
104
279
105
- ! Skip comment lines and preprocessor directives
280
+ ! Skip comment lines and empty lines
106
281
if (index (file_lines_lower(i)% s,' !' ) == 1 .or. &
107
- index (file_lines_lower(i)% s,' #' ) == 1 .or. &
108
282
len_trim (file_lines_lower(i)% s) < 1 ) then
109
283
cycle
110
284
end if
111
285
286
+ ! Handle preprocessor directives
287
+ if (index (file_lines_lower(i)% s,' #' ) == 1 ) then
288
+
289
+ ! If conditional parsing is enabled, track preprocessor blocks
290
+ if (cpp_conditional_parsing) then
291
+
292
+ ! Check for conditional compilation directives
293
+ if (index (file_lines_lower(i)% s,' #ifdef' ) == 1 .or. &
294
+ index (file_lines_lower(i)% s,' #ifndef' ) == 1 .or. &
295
+ index (file_lines_lower(i)% s,' #if ' ) == 1 ) then
296
+
297
+ ! Determine if this conditional block should be active
298
+ call start_cpp_block(cpp_blk, file_lines_lower(i)% s, file_lines(i)% s, preprocess)
299
+
300
+ elseif (index (file_lines_lower(i)% s,' #endif' ) == 1 ) then
301
+
302
+ call end_cpp_block(cpp_blk)
303
+
304
+ elseif (index (file_lines_lower(i)% s,' #else' ) == 1 ) then
305
+
306
+ call handle_else_block(cpp_blk)
307
+
308
+ elseif (index (file_lines_lower(i)% s,' #elif' ) == 1 ) then
309
+
310
+ ! Treat #elif as #else followed by #if
311
+ call handle_else_block(cpp_blk)
312
+ call start_cpp_block(cpp_blk, file_lines_lower(i)% s, file_lines(i)% s, preprocess)
313
+
314
+ end if
315
+
316
+ end if
317
+
318
+ ! Skip all preprocessor directive lines (both old and new behavior)
319
+ cycle
320
+
321
+ end if
322
+
323
+ ! Skip content inside conditional blocks when conditional parsing is enabled
324
+ if (cpp_conditional_parsing .and. cpp_blk% inside_inactive_block) cycle
325
+
112
326
! Detect exported C-API via bind(C)
113
327
if (.not. inside_interface .and. &
114
328
parse_subsequence(file_lines_lower(i)% s,' bind' ,' (' ,' c' )) then
0 commit comments